从bl中绘制垂直线
你好我试图修改这个lisp，只画垂直（或水平）线
(defun c:foo (/ selection pline sscount objpline inspoint intpoint entity)
(if (not (setq selection (ssget "_I" '((0 . "CIRCLE,INSERT")))))
(progn
(prompt "\nSelect circles: ")
(setq selection (ssget '((0 . "CIRCLE,INSERT"))))
)
)
(setq pline (entsel "\nSelect polyline: "))
(if (and
pline
(setq objpline (vlax-ename->vla-object (car pline)))
)
(repeat (setq sscount (sslength selection))
(setq
entity (entget (ssname selection (setq sscount (1- sscount))))
inspoint (cdr (assoc 10 entity)); both center of Circle and insertion pt of Block
intpoint (vlax-curve-getclosestpointto objpline inspoint)
)
(if intpoint
(command "_.line" "non" inspoint "non" intpoint "")
)
)
)
)
我试图修改这行
intpoint（vlax曲线GetClosestPoint到objpline inspoint）
到
intpoint（vlax curve GetClosestPointTopProjection objpline inspoint’（0 1 0）））
但我有一个错误，我认为它忽略了块的Z坐标
你能帮助我吗？
提前谢谢你 发布dwg 你好，比格尔
这是一张附有说明的图纸
目的是随后将多段线转换为尺寸
例如。图纸 尝试：
(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
(if ss
(repeat (setq i (sslength ss))
(setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
)
)
)
(defun KGA_List_Divide_3 (lst / ret)
(repeat (/ (length lst) 3)
(setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
(setq lst (cdddr lst))
)
(reverse ret)
)
(defun KGA_Sys_ObjectOwner (obj)
(vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)
(defun LineToCurve (sta vec curve / end line ptLst)
(setq line
(vla-addline
(KGA_Sys_ObjectOwner curve)
(vlax-3d-point sta)
(vlax-3d-point (mapcar '+ sta vec))
)
)
(if (setq ptLst (KGA_List_Divide_3 (vlax-invoke line 'intersectwith curve acextendthisentity)))
(progn
(setq end (car ptLst))
(foreach pt (cdr ptLst)
(if (< (distance sta pt) (distance sta end))
(setq end pt)
)
)
(vla-put-endpoint line (vlax-3d-point end))
line
)
(progn
(vla-delete line)
nil
)
)
)
(defun c:LinesToCurve ( / curve doc pt1 pt2 ss vec)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc)
(vla-startundomark doc)
(if
(and
(setq curve (car (entsel "\nSelect curve: ")))
(setq curve (vlax-ename->vla-object curve))
(princ "\nSelect blocks: ")
(setq ss (KGA_Conv_Pickset_To_ObjectList (ssget '((0 . "INSERT")))))
(setq pt1 (getpoint "\nFirst point for direction: "))
(setq pt2 (getpoint pt1 "\nSecond point for direction: "))
)
(progn
(setq vec (trans (mapcar '- pt2 pt1) 1 0 T))
(foreach blk ss
(LineToCurve (vlax-get blk 'insertionpoint) vec curve)
)
)
)
(vla-endundomark doc)
(princ)
) 谢谢我是Roy_043
我将使用此方法调整lisp
页:
[1]