[编程交流] 需要测量架线Lisp as

(defun c:imli (/)
 (setq ss (ssget "X"))
 (setq pli (ssnamex ss))
 (setq li (list))
 (foreach a pli
   (setq li
   (append li
           (list (cadr a))
   )
   )
 )
 (setq ali (list))
 (foreach o li
   (setq ali
   (append ali
           (list (entnext o))
   )
   )
 )
 (setq oli (list))
 (foreach ob ali
   (setq oli
   (append oli
           (list (cdr (assoc 1 (entget ob))))
   )
   )
 )
 (setq cli (list))
 (foreach c li
   (setq cli
   (append cli
           (list (cdr (assoc 10 (entget c))))
   )
   )
 )
 (setq cnt 0)
 (setq fli (list))
 (while (/= cnt (length cli))
   (setq fli
   (append fli
           (list (cons (nth cnt oli) (nth cnt cli)))
   )
   )
   (setq cnt (1+ cnt))
 )
 (setq slist (getstring t "\nEnter imovable limit point numbers: "))
 (setq lst (list))
 (while (setq pt (vl-string-search " " slist))
   (setq lst (cons (substr slist 1 pt) lst))
   (setq slist (substr slist (+ pt 2)))
 )
 (setq lst (reverse (cons slist lst)))
 (setq        als (list)
cnt 0
 )
 (while (/= cnt (length lst))
   (foreach a fli
     (setq als
     (append als
             (if (= (nth cnt lst) (car a))
               (list (cons 10 (cdr a)))
             )
     )
     )
   )
   (setq cnt (1+ cnt))
 )
 (setq vn (length als))
 (setq        adl    (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(100 . "AcDbPolyline")
             (cons 90 vn)
             '(70 . 1)
       )
adf    (list '(210 0.0 0.0 1.0))
enlist (append adl als)
enlist (append enlist adf)
 )
 (entmake enlist)
 (princ)
)

[b][color="#a0522d"] CODE removed[/color][/b]
[color="blue"][b] [refer to post # 33 for updated code][/b][/color]
 

(defun c:ll(/ point1 point11 ss1 ent1 listent xy1
             point2 point22 ss2 ent2 listen2 xy2)
      (SetVar "cmdecho" 0);
      (SetQ point1 (getstring " give the number or the name of the point ? "))
      (SetQ point11 (strcat point1 ))
      (if (= point11 "")
          (progn
                (princ "\n")
                (SetQ xy1 (getpoint "from point "))
                (command "line" xy1)
          )
          (progn
                ;(command "time" "d" "")
                ;(SetQ qqq (ssget "X" (list (cons 0 "TEXT"))))
                ;(SetQ www (sslength qqq))
                ;(print www)
                ;(command "time" "d" "")
                (SetQ ss1 (ssget "X" (list (cons 0 "TEXT") (cons 1 point11) (cons 8 "labels"))))
                (SetQ ent1 (ssname ss1 0))
                (SetQ listent (entget ent1))
                (SetQ xy1 (cdr (assoc 11 listent)))     ;find x1,y1
;
;
                (command "line" xy1 )
          )
      )
      (while (/= xy1 nil)
             (SetQ point2 (getstring "to point ? "))
             (SetQ point22 (strcat point2 ))
;
             (if (= point22 "")
                 (progn
                       (princ "\n")
                       (SetQ xy2 (getpoint "to point "))
                       (command xy2)
                 )
                 (progn
                       (SetQ ss2 (ssget "X" (list (cons 0 "TEXT") (cons 1 point22) (cons 8 "labels"))))
;
                       (SetQ ent2 (ssname ss2 0))
                       (SetQ listent2 (entget ent2))
                       (SetQ xy2 (cdr (assoc 11 listent2)))    ;find x2,y2
;;
;;
                       (command xy2 )
                 )
             )
             (= (SetQ xy1 xy2))         ;reverse xy1 me xy2
      )
)