[编程交流] 自动绘制多段线

 
;Created by B. Hippe
;October 2011
;Select points you wish to snap to.
;Click button to start.
;Hover mouse over the selected points in the order you wish to have them drawn.
[color="red"](vl-load-com)[/color]
(defun c:AutoPL ()
 (setq *ModSpc (vlax-get-property (setq *ActDoc (vlax-get-property (setq *acad (vlax-get-acad-object)) 'ActiveDocument)) 'ModelSpace))
 (princ "\nSelect Point Objects:")
 (setq ss (ssget '(( 0 . "POINT"))))
 (setq sslen (sslength ss))
 (setq drawn nil)
 (setq junk (getpoint "\nClick to Start:"))
 (setq done nil)
 (while
   (and (= 5 (car (setq pnt (grread T 1 0)))) (= done nil))
   (setq ep (is_nearest ss (nth 1 pnt)))
   (cond
     ((= drawn nil)(progn
       (setq drawn (list (car ep)))
       (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates))))))
     ((= (length drawn) 1)(if (not (is_drawn (car ep)))
       (progn
         (setq drawn (cons (car ep) drawn))
         (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
     ((>= (length drawn) 2)(if (not (is_drawn (car ep)))
        (progn
   (setq drawn (cons (car ep) drawn))
   (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
     )
   (if (= sslen (length drawn))
     (setq done T))
   )
 (setq pl-obj (vlax-invoke-method *ModSpc 'Addpolyline (pl->var (drawn->pntlist))))
 (princ)
 )
;Returns a list (entity . distance) of the closest entity (point) to the givin point
;Closest being the 2D distance
(defun is_nearest (ss opnt)
 (setq ss-len (sslength ss))
 (setq li '(0))
 (setq n 0)
 (repeat ss-len
   (setq ent (ssname ss n))
   (setq pnt (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) 'Coordinates))))
   (setq dist (distance (list (nth 0 opnt)(nth 1 opnt))(list (nth 0 pnt)(nth 1 pnt))))
   (setq pair (cons ent dist))
   (setq li (cons pair li))
   (setq n (1+ n))
   )
 (setq li (cdr (reverse li)))
 (setq li (vl-sort li (function (lambda (x y) (< (cdr x)(cdr y))))))
 (setq near-pair (nth 0 li))
 )
;graphically draws an X at a givin point
(defun drx (ctr)
 (setq vs (getvar "viewsize"))
 (setq xs (/ vs 20))
 (setq xs2 (/ xs 2))
 (setq cor1 (polar ctr (* pi 0.25) xs2))
 (setq cor2 (polar ctr (* pi 0.75) xs2))
 (setq cor3 (polar ctr (* pi 1.25) xs2))
 (setq cor4 (polar ctr (* pi 1.75) xs2))
 (grdraw ctr cor1 2 0)
 (grdraw ctr cor2 2 0)
 (grdraw ctr cor3 2 0)
 (grdraw ctr cor4 2 0)
 )
;Determines if a givin entity is a member of the "drawn" list
(defun is_drawn (ent)
 (/= nil (member ent drawn)))
;create a list of coordinates for each entity in the list "drawn"
(defun drawn->pntlist ()
 (setq plist (mapcar '(lambda (ent) (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object ent) 'Coordinates)))) drawn))
 (setq li '("x"))
 (setq n 0)
 (repeat (length plist)
   (setq p (nth n plist))
   (setq li (cons (nth 2 p) li))
   (setq li (cons (nth 1 p) li))
   (setq li (cons (nth 0 p) li))
   (setq n (1+ n))
   )
 (setq li (reverse (cdr (reverse li))))
 )
;Givin a point list returns the list in variant form
(defun PL->VAR ( pl / pl ub sa var)
 (setq ub (- (length [color=red]pl[/color]) 1))
 (setq sa (vlax-make-safearray vlax-vbdouble (cons 0 ub)))
 (setq var (vlax-make-variant (setq sa (vlax-safearray-fill sa pl))))
 )

(setq obj (vlax-ename->vla-object (car (entsel "\nSelect a polyline: "))))
(vlax-get obj 'Coordinates)

(defun c:test ( / ss->lst addpolyline *error* ss pt gr )
 (defun ss->lst ( ss flag / id lst )
   (if (eq 'PICKSET (type ss))
     (repeat (setq id (sslength ss))
       (
         (lambda ( name )
           (setq lst
             (cons
               (if flag (vlax-ename->vla-object name)
                 name
               )lst
             )
           )
         )(ssname ss (setq id (1- id)))
       )
     )
   )
 )
 (defun addpolyline ( pointslst layer closed flag / e )
   (setq e 
     (entmakex
       (append
         (list
           (cons 0 "LWPOLYLINE")
           (cons 100 "AcDbEntity")
           (cons 100 "AcDbPolyline")
           (cons 90 (length pointslst))
           (cons 70 (if closed 1 0))
           (cons 8 layer)
           (cons 43 0.0)
         )
         (mapcar
           (function
             (lambda ( x ) 
               (if (listp x)(cons 10 x)
                 (cons 42 x)
               )
             )
           ) pointslst
         )
       )
     )
   )
   (if (and e flag)
     (vlax-ename->vla-object e) e
   )
 )
 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (if 
   (and
     (setq ss (ss->lst (ssget '((0 . "point"))) t))
     (setq pt (getpoint "\nSpecify starting point: "))
     (not 
       (vla-highlight 
         (car 
           (ss->lst (ssget pt '((0 . "point"))) t)
         ) 1
       )
     )
     (setq pt (list pt))
   )
   (progn
     (while (eq 5 (car (setq gr (grread t 5))))
       (foreach x (ss->lst (ssget (cadr gr) '((0 . "point"))) t)
         (if 
           (and (vl-position x ss)
             (not 
               (vl-position (vlax-get x 'coordinates)
                 pt
               )
             )
           )
           (progn (vla-highlight x 1)
             (setq pt (cons (vlax-get x 'coordinates) pt))
           )
         )
       )
     )
     (addpolyline (reverse pt) (getvar 'clayer) nil nil )
   )
 ) (vla-regen (ad) acactiveviewport)(princ)
)

 
;Created by B. Hippe
;October 2011
;Select points you wish to snap to.
;Click button to start.
;Hover mouse over the selected points in the order you wish to have them drawn.
[color="red"](vl-load-com)[/color]
(defun c:AutoPL ( / *ModSpc *ActDoc *acad ss sslen junk done pnt ep )
 (setq *ModSpc (vlax-get-property (setq *ActDoc (vlax-get-property (setq *acad (vlax-get-acad-object)) 'ActiveDocument)) 'ModelSpace))
 (princ "\nSelect Point Objects:")
 (setq ss (ssget '(( 0 . "POINT"))))
 (if (or (= ss nil)(= (sslength ss) 1))
   (progn
     (princ "\nOops! Little to Nothing has been Selected.")
     (exit)
     )
   )
 (setq sslen (sslength ss))
 (setq drawn nil)
 (setq junk (getpoint "\nClick to Start:"))
 (setq done nil)
 (while
   (and (= 5 (car (setq pnt (grread T 1 0)))) (= done nil))
   (setq ep (is_nearest ss (nth 1 pnt)))
   (cond
     ((= drawn nil)(progn
       (setq drawn (list (car ep)))
       (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates))))))
     ((= (length drawn) 1)(if (not (is_drawn (car ep)))
       (progn
         (setq drawn (cons (car ep) drawn))
         (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
     ((>= (length drawn) 2)(if (not (is_drawn (car ep)))
        (progn
   (setq drawn (cons (car ep) drawn))
   (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
     )
   (if (= sslen (length drawn))
     (setq done T))
   )
 (setq pl-obj (vlax-invoke-method *ModSpc 'Addpolyline (pl->var (drawn->pntlist))))
 (princ)
 )
;Returns a list (entity . distance) of the closest entity (point) to the givin point
;Closest being the 2D distance
(defun is_nearest (ss opnt / ss-len li n ent pnt dist pair near-pair)
 (setq ss-len (sslength ss))
 (setq li '(0))
 (setq n 0)
 (repeat ss-len
   (setq ent (ssname ss n))
   (setq pnt (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) 'Coordinates))))
   (setq dist (distance (list (nth 0 opnt)(nth 1 opnt))(list (nth 0 pnt)(nth 1 pnt))))
   (setq pair (cons ent dist))
   (setq li (cons pair li))
   (setq n (1+ n))
   )
 (setq li (cdr (reverse li)))
 (setq li (vl-sort li (function (lambda (x y) (< (cdr x)(cdr y))))))
 (setq near-pair (nth 0 li))
 )
;graphically draws an X at a givin point
(defun drx (ctr / vs xs xs2 cor1 cor2 cor3 cor4 ctr)
 (setq vs (getvar "viewsize"))
 (setq xs (/ vs 20))
 (setq xs2 (/ xs 2))
 (setq cor1 (polar ctr (* pi 0.25) xs2))
 (setq cor2 (polar ctr (* pi 0.75) xs2))
 (setq cor3 (polar ctr (* pi 1.25) xs2))
 (setq cor4 (polar ctr (* pi 1.75) xs2))
 (grdraw ctr cor1 2 0)
 (grdraw ctr cor2 2 0)
 (grdraw ctr cor3 2 0)
 (grdraw ctr cor4 2 0)
 )
;Determines if a givin entity is a member of the "drawn" list
(defun is_drawn (ent)
 (/= nil (member ent drawn)))
;create a list of coordinates for each entity in the list "drawn"
(defun drawn->pntlist ( / plist ent li n )
 (setq plist (mapcar '(lambda (ent) (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object ent) 'Coordinates)))) drawn))
 (setq li '("x"))
 (setq n 0)
 (repeat (length plist)
   (setq p (nth n plist))
   (setq li (cons (nth 2 p) li))
   (setq li (cons (nth 1 p) li))
   (setq li (cons (nth 0 p) li))
   (setq n (1+ n))
   )
 (setq li (reverse (cdr (reverse li))))
 )
;Givin a point list returns the list in variant form
(defun PL->VAR ( pl / ub sa var)
 (setq ub (- (length [color=red]pl[/color]) 1))
 (setq sa (vlax-make-safearray vlax-vbdouble (cons 0 ub)))
 (setq var (vlax-make-variant (setq sa (vlax-safearray-fill sa pl))))
 )