[编程交流] 点对点距离lsp需要he

(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 )   
)