home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Current Shareware 1994 January
/
SHAR194.ISO
/
cad_util
/
v8n8_cad.zip
/
SD.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1993-07-23
|
6KB
|
212 lines
(defun SD_ARROW (PT DA DA3)
(entmake
(list
'(0 . "SOLID")
(cons 10 PT)
(list 11 (- (car PT) DA3) (+ (cadr PT) DA) 0.0)
(list 12 (+ (car PT) DA3) (+ (cadr PT) DA) 0.0)
(list 13 (+ (car PT) DA3) (+ (cadr PT) DA) 0.0)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SD_LINE (P1 P2)
(entmake
(list
'(0 . "LINE")
(cons 10 P1)
(cons 11 P2)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SD_TEXT (S PT JST / BX BY TENG ELFG FLG)
(setq BX (textbox (list (cons 1 S))) ;;text limits
BX (mapcar '- (cadr BX) (car BX)) ;;delta size
BY (/ (cadr BX) 2.0) ;;1/2 Y difference
)
(cond
((= JST 1) ;;left midpoint given
(setq TENG (list (car PT) (- (cadr PT) BY) 0.0)
ELFG (list 0.0 0.0 0.0)
FLG 0)
)
((= JST -1) ;;right midpoint given
(setq TENG (list (- (car PT) (car BX))
(- (cadr PT) BY) 0.0)
ELFG (list (car PT)
(- (cadr PT) BY) 0.0)
FLG 2)
)
)
(entmake
(list
'(0 . "TEXT")
(cons 10 TENG)
(cons 11 ELFG)
(cons 1 S)
(cons 40 TS)
'(50 . 0.0)
(cons 72 FLG)
)
)
)
(defun SD_VARS ( / T1 T2)
(setq SD_PNT (entsel "\nLocate center line: "))
(if SD_PNT
(progn
(setq
SD_PNT (cdr (assoc 10 (entget (car SD_PNT))))
T1 (getdist (strcat "\nDimension text size <"
(rtos (getvar "DIMTXT")) ">: "))
T2 (getdist (strcat "\nArrow size <"
(rtos (getvar "DIMASZ")) ">: "))
T3 (getstring (strcat "\nDimension layer name <"
(getvar "CLAYER") ">: "))
)
(if (null T1)
(setq T1 (getvar "DIMTXT"))
(setvar "DIMTXT" T1)
)
(if (null T2)
(setq T2 (getvar "DIMASZ"))
(setvar "DIMASZ" T2)
)
(if (= T3 "")
(setq T3 (getvar "CLAYER"))
(command "_LAYER" "_M" T3 "")
)
(setq TS T1
DA T2
DL T3
DA3 (/ DA 6.0) ;;arrow size 3::1
)
)
(prompt "\nFunction cancelled, no center line selected")
)
)
(defun SD_LEADER ( / EXIT VECS)
(setq EXIT nil
P2 nil
VECS nil)
(while (null EXIT)
(setq P2 (grread 'T 4 1)) ;(id 3d_pnt)
(if VECS
(grvecs VECS))
(cond
((= (car P2) 5)
(setq P2 (cadr P2))
(grvecs
(setq VECS
(list 257 P1 (list (car P1) (cadr P2) 0.0)
257 (list (car P1) (cadr P2) 0.0) P2
)
)
)
)
((= (car P2) 3)
(setq P2 (cadr P2)
EXIT 'T)
)
((and (= (car P2) 2)
(= (cadr P2) 13)) ;;return request
(setq EXIT 'T)
)
((and (= (car P2) 2)
(= (cadr P2) 27)) ;;ESC
(setq EXIT 'T
P2 nil)
)
)
)
P2 ;;returns P2 value. NIL if no point selected
)
(defun SD_TEXT_ED ()
(setq DD (* 2.0 (abs (- (cadr P1) (cadr SD_PNT)))))
(if (= (getvar "DIMTOL") 0)
(progn
(setq TMP
(getstring 1
(strcat "\nNew dimension text <" (rtos DD) ">: "))
)
(if (= TMP "") (setq TMP (rtos DD)))
)
(progn
(setq TMP1
(getstring 1
(strcat "\nNew upper text <"
(rtos (+ DD (getvar "DIMTP"))) ">: ")))
(if (= TMP1 "") (setq TMP1 (rtos (+ DD (getvar "DIMTP")))))
(setq TMP2
(getstring 1
(strcat "\nNew lower text <"
(rtos (- DD (getvar "DIMTM"))) ">: ")))
(if (= TMP2 "") (setq TMP2 (rtos (- DD (getvar "DIMTM")))))
)
)
)
(defun SD_TEXT_PUT ()
(if (> (car P2) (car P1))
(setq AA 0.0
JT 1) ;; left justified
(setq AA PI
JT -1) ;; right justified
)
(if (= (getvar "DIMTOL") 0)
(SD_TEXT TMP (polar P2 AA (/ TS 2)) JT) ;;single line of text
(progn ;;ELSE dimtol is active, two lines of text
(SD_TEXT TMP1 (list (+ (car P2) (* TS 0.5 JT))
(+ (cadr P2) (* TS 0.75))
0.0)
JT)
(SD_TEXT TMP2 (list (+ (car P2) (* TS 0.5 JT))
(- (cadr P2) (* TS 0.75))
0.0)
JT)
)
)
)
(defun C:SD ( / DL DA DA3 TS P1 P2 P3 TMP TMP1 TMP2)
(prompt "\nSD: SHAFT Dimensioning Bill Kramer CADENCE 8/93")
(if (SD_VARS) ;;sets SD variables up from user input
(progn
(command "_LAYER" "_S" DL "")
(while (setq P1
(getpoint "\nLocate point on radius to dimension: "))
(if (SD_LEADER) ;;operator shows location of dimension text
(progn
(SD_TEXT_ED) ;;operator override of text value
(if (> (cadr P2) (cadr P1)) ;;above CL?
(progn
(setq P3 (list (car P1)
(- (cadr P1) DD) 0.0)) ;; other side of CL
(SD_ARROW P1 DA DA3)
(SD_ARROW P3 (* -1 DA) DA3)
(SD_LINE P3 (polar P3 (* 1.5 PI) (* 2 DA)))
)
(progn ;;below CL
(setq P3 (list (car P1)
(+ (cadr P1) DD) 0.0))
(SD_ARROW P1 (* -1 DA) DA3)
(SD_ARROW P3 DA DA3)
(SD_LINE P3 (polar P3 (* 0.5 PI) (* 2 DA)))
)
)
(SD_LINE P1 (list (car P1) (cadr P2) 0.0))
(SD_LINE (list (car P1) (cadr P2) 0.0) P2)
(SD_TEXT_PUT)
)
)
)
)
)
(princ)
)