home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BUG 15
/
BUGCD1998_06.ISO
/
aplic
/
felixcad
/
fcaddata.z
/
CONE2D.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1996-02-13
|
5KB
|
130 lines
;;; CONE2D.LSP
;;; =======================================================
;;; DrawUtilility TRAPEZOID.
;;; Provided by Felix CAT GmbH 1996 as FCAD Application Sample
;;; =======================================================
;;; DESCRIPTION:
;;; =======================================================
;;; SAMPLE FOR:
;;; getpoint, getangle, getdist, getreal, initget
;;; entmake
;;; =======================================================
;;; CHANGES might be:
;;;### Enter Ratio not only as [1:n], but also as [n:1] !
;;;### Evaluate and Set Construction Line Layer !
;;; =======================================================
(defun C:KONUS() (C:TRAPEZOID)(princ)) ;;; ### GERMAN COMMAND
(defun C:TRAPEZOID ( / lang prt_list MAKE_LINE
ins_ang ang d1 d2 l e p1 p2 p3 p4 p5)
(if (> (getvar "ACTDB") -1) (progn
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(defun *ERROR* (msg)
(setq *ERROR* nil)
(princ)
)
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(setq lang (getvar "LANGUAGE") )
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(setq prt_list (cond
((= lang 1) (list
"Einfⁿgepunkt: "
"Einfⁿgewinkel <0>: "
"Durchmesser der ersten Seite: "
"LΣnge: "
"Verjⁿngung"
"Durchmesser der zweiten Seite: "
"Verjⁿngung"
"VerjⁿngungsverhΣltnis 1 : "
"Ungⁿltiges VerjⁿngungsverhΣltnis. \nDer zweite Durchmesser mu▀ gr÷▀er 1 sein."
"Achtung"
))
(T (list
"Insertion point: " ;;; 0
"Insertion angle <0>: " ;;; 1
"Diameter of first side: " ;;; 2
"Length: " ;;; 3
"Ratio" ;;; 4
"Diameter of second side: " ;;; 5
"Ratio" ;;; 6
"Ratio 1 : " ;;; 7
"Invalid ratio. \nSecond diameter must be greater than 1." ;;; 8
"Alert" ;;; 9
))
))
(defun MAKE_LINE (par1 par2 par3 / el ln ll par1 par2 par3)
(setq ln (cons 8 (getvar "CLAYER")))
(setq ll (cons 8 "CLINE")) ;;; Construction Line Layer !
(setq el (list
(cons 0 "LINE") ln (cons 10 par1) (cons 11 par2) ;;; ll
))
(entmake el)
)
(initget 1)
(setq e (getpoint (nth 0 prt_list))) ;;;@Insertion point:
(setq ins_ang (getangle e (nth 1 prt_list))) ;;;@Insertion angle <0>:
(if (not ins_ang)(setq ins_ang 0))
(initget 1)
(setq d1 (getdist (nth 2 prt_list))) ;;;@Diameter of first side:
(initget 1)
(setq l (getdist e (nth 3 prt_list))) ;;;@Length:
(setq f1 T)
(initget 256 (nth 4 prt_list)) ;;;@Ratio
(setq d2 (getdist (nth 5 prt_list))) ;;;@Diameter of second side:
(if (= d2 (nth 4 prt_list)) (setq d2 nil)) ;;;@Ratio
(if (not d2)
(progn
(while f1
(initget (+ 1 2))
(setq d2 (getreal (nth 7 prt_list))) ;;;@Ratio 1 :
(setq d2 (- d1 (* (/ 1.0 d2) l)))
(if (minusp d2)
(alert
(nth 8 prt_list) ;;;@Invalid ratio. \nSecond diameter must be greater than 1.
(nth 9 prt_list) ;;;@Alert
"EXCLAMATION"
)
(setq f1 nil)
)
)
)
)
(setq ang (+ ins_ang (/ pi 2.00)))
(setq p4 (polar e ins_ang l))
(setq p2 (polar e ang (/ d1 2.00)))
(setq p3 (polar p4 ang (/ d2 2.00)))
(setq p1 (polar p2 (+ ang pi) d1))
(setq p5 (polar p3 (+ ang pi) d2))
(MAKE_LINE p1 p2 nil)
(MAKE_LINE p2 p3 nil)
(MAKE_LINE p3 p5 nil)
(MAKE_LINE p5 p1 nil)
;;; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; ### Draw Center Line: Function MEC_CENTERLINE may be defined
; ### in Mechanical application to draw center line !
(if MEC_CENTERLINE (progn
(setq d1 (if $center2 $center2 (* (+ d1 d2) 0.125) ) )
(MEC_CENTERLINE (polar e (+ ins_ang pi) d1) (polar e ins_ang (+ l d1)) nil nil)
))
;;; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
(setq *ERROR* nil)
(princ)
))
)
;;; =======================================================
(if (= (getvar "LANGUAGE") 1)
(progn
(princ "Befehl KONUS geladen.")
(setfunhelp "C:KONUS" "Konus" "fcad")
)
(progn
(princ "Command TRAPEZOID loaded.")
(setfunhelp "C:TRAPEZOID" "Trapezoid" "fcad")
)
)
(terpri)
(princ)