自动绘制多段线
大家好！我最近在这里创建了这个例程，希望与大家分享！
到目前为止，我有它与ACAD点工作，并有一个单独的副本与Civil 3D点工作。
;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.
(vl-load-com)
(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 pl) 1))
(setq sa (vlax-make-safearray vlax-vbdouble (cons 0 ub)))
(setq var (vlax-make-variant (setq sa (vlax-safearray-fill sa pl))))
)
*请注意，我没有包括任何错误捕捉。我认为这个例程可以改进，添加功能、错误捕捉等等。对想法、评论和批评持开放态度。（如果有人想创建这个命令的一个很酷的动画，那也太酷了！）
当做
Hippe013 尝试：
(setq obj (vlax-ename->vla-object (car (entsel "\nSelect a polyline: "))))
(vlax-get obj 'Coordinates)
请添加（vl load com） 如果用户没有选择实体怎么办？？
嗯。。。你试过代码了吗？
我创建它是为了绘制一条点到点的多段线。点对点点击几百个点可能会很乏味。这段代码允许您只选择要捕捉到的点，然后只需将鼠标悬停在这些点上。
不过我很感谢你的意见
当做
嗯？？？那么，你有什么建议？
我想现在只要再喝一口咖啡，再下一次命令就行了。
您是否认为可以在mid命令中向选择集添加点？
我向Dan的帖子指出，如果用户选择nothing（无），该帖子将导致例程崩溃。
在调用代码时，最好将变量本地化，以避免代码转到其他地方。 希望你不介意
(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.
(vl-load-com)
(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 pl) 1))
(setq sa (vlax-make-safearray vlax-vbdouble (cons 0 ub)))
(setq var (vlax-make-variant (setq sa (vlax-safearray-fill sa pl))))
)
局部变量，为零选择集添加了错误陷阱。
我的一个问题是，我有不同的子例程，将利用列表“绘制”。我应该如何处理这个问题？它不能本地化，或者可以吗？如果我让它成为本地的，其他例程可以使用它吗？
谢谢 可能是多边形内的某种形式，但多边形是通过使用多边形宽度因子绘制初始线来创建的。
页:
[1]
2