点对点距离lsp需要he
我使用该lsp放置管道尺寸和从拾取点到拾取点的距离。我知道它写得很差，需要一些帮助才能把它整理好。看一看，看看你是否有任何改进的想法。(defun c:sst (/ midl dis psz pipe ppp)
(setq OLDOS (getvar "OSMODE" ))
(setq olay (getvar "clayer" ))
(setvar "dimzin" 1 )
(setvar "attdia" 0 )
(setvar "attreq" 1 )
(while
(setvar "OSMODE" 69 )
(princ (strcat "\n Pipe Size:< ")) (princ ppp)
(INITGET 6)
(setq psz (GETSTRING " >: "))
(if (= PSZ "")(setq PSZ pipe))
(cond
((= psz "1" )(setq pipe "1" ) (setq ppp "1\"" ))
((= psz "1~" )(setq pipe "1~" )(setq ppp "1-1/4\"" ))
((= psz "1`" )(setq pipe "1`" )(setq ppp "1-1/2\"" ))
((= psz "2" )(setq pipe "2" )(setq ppp "2\"" ))
((= psz "2`" )(setq pipe "2`" )(setq ppp "2-1/2\"" ))
((= psz "3" )(setq pipe "3" )(setq ppp "3\"" ))
((= psz "4" )(setq pipe "4" )(setq ppp "4\"" ))
((= psz "6" )(setq pipe "6" )(setq ppp "6\"" ))
((= psz "8" )(setq pipe "8" )(setq ppp "8\"" ))
((= psz "10" )(setq pipe "10" )(setq ppp "10\"" ))
)
(if (setq pt1 (getpoint "\nFirst point: "))
(= pt1 "")(setq pt1 pt3))
(setq pt2 (getpoint "\nSecond point: "))
(if (= pt2 nill )(setvar "clayer" olay )
(SETVAR "OSMODE" OLDOS ))
(setq MX (/ (+ (car PT1) (car PT2)) 2)
MY (/ (+ (cadr PT1) (cadr PT2)) 2)
MIDL (list MX MY 0))
(setq dis (distance pt1 pt2 ))
(setq ang (angle pt1 pt2 ))
(if (>= ang 0)
(setq ang1 ang)
)
(if (> ang 1.5708);same as 90°
(setq ang1 (+ 3.14159 ang));add 180°
)
(if (>= ang 4.71413);same as 270.1°
(setq ang1 ang)
)
(setq angd (rtd ang1 ))
(setq dis (rtos dis 4 0 ))
(setvar "OSMODE" 0 )
(command "-layer" "m" "PTAG" "c" "7" "" "")
(command "insert" "P_TAG" midl binssc binssc angd dis pSZ "")
(setq pt3 pt2)
(setq attent (entget (entlast)))
(setq atttag (cdr (assoc 2 attent )))
(setq entn (entget (entnext (cdr (car attent)))))
(setq attnam (cdr (assoc 2 entn )))
(setq atttag (cdr (assoc 2 entn )))
(if (= attnam atttag)
(progn
(setq str (cdr (assoc 1 entn )))
(setq strl (strlen str ))
(cond ((= (wcmatch str "#\.") T ) (setq stal 2 ))
((= (wcmatch str "##\.") T ) (setq stal 3 ))
((= (wcmatch str "#.-#\.") T ) (setq stal 4 ))
((= (wcmatch str "#.-##\.") T ) (setq stal 5 ))
((= (wcmatch str "##.-#\.") T ) (setq stal 6 ))
((= (wcmatch str "##.-##\.") T ) (setq stal 7 ))
((= (wcmatch str "###.-#\.") T ) (setq stal 8 ))
((= (wcmatch str "###.-##\.") T ) (setq stal 9 ))
)
(setq stnum (substr str 1 stal ))
(setq rstal (+ stal 1 ))
(setq strest (substr str rstal strl ))
(setq stnuml (strlen stnum ))
(cond((= stnuml 2 )
(setq p1 "0-" )
(setq p2 (substr stnum 1 1 ))
)
((= stnuml 3 )
(setq p1 "0-" )
(setq p2 (substr stnum 1 2 ))
)
((= stnuml 4 )
(setq p1 (substr stnum 1 1 ))
(setq p2 (substr stnum 4 4 ))
)
((= stnuml 5 )
(setq p1 (substr stnum 1 1 ))
(setq p2 (substr stnum 4 5 ))
)
((= stnuml 6 )
(setq p1 (substr stnum 1 2 ))
(setq p2 (substr stnum 5 5 ))
)
((= stnuml 7 )
(setq p1 (substr stnum 1 2 ))
(setq p2 (substr stnum 5 6 ))
)
((= stnuml 8 )
(setq p1 (substr stnum 1 3 ))
(setq p2 (substr stnum 6 6 ))
)
((= stnuml 9 )
(setq p1 (substr stnum 1 3 ))
(setq p2 (substr stnum 6 7 ))
)
)
(setq P1I (atoi P1 ))
(setq P2I (atoi P2 ))
(setq PP1 (itoa P1I))
(setq PP2 (itoa P2I))
(setq NN1 (strcat PP1 "-" PP2 ))
(setq newatt NN1 )
(setq entn (subst (cons 1 newatt ) (assoc 1 entn ) entn ))
(entmod entn )
(entupd (entlast))
);progn
);if
);while
(setvar "clayer" olay )
(SETVAR "OSMODE" OLDOS )
)
页:
[1]