如何在l周围创建间隙
有没有办法创建lips程序或vba宏来偏移两侧的一条线，保留源，然后修剪两条偏移线之间的所有内容并删除它们。或者有没有办法在多重引线周围创建相同的效果？
类似于所附图片上描述的内容
欢迎来到CadTutor
尝试此代码。。。
(defun c:test (/ *error* dxf s ss of obj in nm lst p)
;;--- Tharwat 19. April. 2013 ---;;
(defun *error* (x)
(setvar 'cmdecho 1)
(princ (strcat "\n Error ... " x))
)
(defun dxf (n o) (cdr (assoc n (entget o))))
(if (and (progn (princ "\n Select single line ... >> ")
(setq s (ssget "_+.:S:L" '((0 . "LINE"))))
)
(setq ss (ssget "_X" '((0 . "LINE"))))
(setq of (getdist "\n Specify offset distance :"))
)
(progn
(setq obj (vlax-ename->vla-object (ssname s 0)))
(repeat (setq in (sslength ss))
(if
(not
(eq 4
(logand
4
(cdr
(assoc
70
(entget
(tblobjname
"LAYER"
(dxf 8 (setq nm (ssname ss (setq in (1- in)))))
)
)
)
)
)
)
)
(setq lst (cons nm lst))
)
)
(setvar 'cmdecho 0)
(foreach e lst
(if (and (setq p (vlax-invoke
obj
'IntersectWith
(vlax-ename->vla-object e)
acExtendNone
)
)
(> (distance (dxf 10 e) (dxf 11 e)) (* of 2.))
)
(command "_.break"
e
"_none"
(vlax-curve-getclosestpointto
e
(polar p (angle (dxf 10 e) (dxf 11 e)) of)
)
"_none"
(vlax-curve-getclosestpointto
e
(polar p (angle (dxf 11 e) (dxf 10 e)) of)
)
)
)
)
(setvar 'cmdecho 1)
)
)
(princ "\n Written by Tharwat Al Shoufi")
(princ)
)
(vl-load-com)
(defun c:demo (/ s ss spacepntlst TempL p p1 p2)
(vl-load-com)
(setq space (vlax-get
(vla-get-ActiveLayout
(vla-get-activedocument
(vlax-get-acad-object)
)
)
'Block
)
)
(if (and (setq s (ssget "_+.:S:L" '((0 . "MULTILEADER"))))
(setq s (vlax-ename->vla-object (ssname s 0)))
(setq width (cond
((getdist (strcat "\nEnter width "
(if width (strcat " <" (rtos width) ">: ") ": ")
)))(width))
)
(setq w (* 0.5 width))
)
(progn
(setq pntlst (vlax-invoke
s 'GetLeaderLineVertices0
)
zv (nth 2 pntlst)
)
(setq TempL
(vlax-invoke
space
'AddLightweightPolyline
(vl-remove-if '(lambda (l) (= zv l)) pntlst)
))
(setq ss (ssget "_:L"))
(repeat (setq i (sslength ss))
(if (setq p (vlax-invoke
TempL
'IntersectWith
(setq
e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
)
acExtendNone
)
)
(progn
(setq p1 (vlax-curve-getpointatDist
e (- (vlax-curve-getDistAtPoint e p) w))
p2 (vlax-curve-getpointatDiste
(+ (vlax-curve-getDistAtPoint e p) w)
)
)
(command "_break" (ssname ss i) "_non" p1 "_non" p2)
)
)
)
(vla-delete TempL)
)
)(princ)
) 更详细一点，剪切倍数表示跟随一条pline，非常简单，在两个方向上偏移pline记住这些对象，然后修剪obj1 obj2“F”拾取原始pline全部完成擦除obj1 obj2。lisp使这变得简单而透明。 这就是我之前的想法，直到我看到“刀刃”是一个多重引线：
随便。线路的快速连接
(defun c:test ( / s ss width)
(if (and (setq s (ssget "_+.:S:L" '((0 . "LINE"))))
(setq s(vlax-ename->vla-object (ssname s 0))
ss (ssadd)
)
(setq width (getdist "\nEnter width: "))
)
(progn
(vlax-invoke s 'offset (- (* 0.5 width)))
(ssadd (entlast) ss)
(vlax-invoke s 'offset (* 0.5 width))
(ssadd (entlast) ss)
(command "_trim" ss
"""_Fence""_non"
(vlax-get s 'StartPoint)
"_non" (vlax-get s 'EndPoint)
""
)
(command "_erase" ss "" "")
)
)(
princ)
) DWG不幸。。。有了消灭，就不会被肢解。
我不知道那是什么意思 @pBe。
你帖子的最后一个paren#5用完了代码标签。
它是如何到达那里的。令人不快的错误的括号。。。
我的意思是，如果你只是用抹布覆盖它们，也许你不需要切割所有的物体。
记住将“帧”设置为“关”
(defun c:demo (/ s s1 ss space pntlst w pntlst zv TempL TempL1 TempL2 Lv L1v L2v )
(vl-load-com)
(setq space (vlax-get
(vla-get-ActiveLayout
(vla-get-activedocument
(vlax-get-acad-object)
)
)
'Block
)
)
(if (and
(princ "\nSelect MLeader")
(setq s (ssget "_+.:S:L" '((0 . "MULTILEADER"))))
(setq s (vlax-ename->vla-object (setq s1 (ssname s 0))))
(setq width (cond
((getdist (strcat "\nEnter width "
(if width (strcat " <" (rtos width) ">: ") ": ")
)))(width))
)
(setq w (* 0.5 width))
)
(progn
(setq pntlst (vlax-invoke
s 'GetLeaderLineVertices0
)
zv (nth 2 pntlst)
)
(setq TempL
(vlax-invoke
space
'AddLightweightPolyline
(vl-remove-if '(lambda (l) (= zv l)) pntlst)
)
)
(vlax-invoke TempL 'offset (- (* 0.5 width)))
(setq TempL1 (entlast))
(vlax-invoke TempL 'offset (* 0.5 width))
(setq TempL2 (entlast))
(setq
Lv1 (coo TempL1)
Lv2 (coo TempL2)
Lv (append Lv1 (reverse Lv2))
)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
(command "_.wipeout")
(apply 'command Lv)
(command "")
(setvar 'osmode os)
(command "_.draworder" s1 "" "_F")
(vla-delete TempL)
(entdel TempL1)
(entdel TempL2)
)
)
)
(defun Coo ( a / coor)
(mapcar '(lambda (x)
(if (eq (car x) 10)
(setq coor (cons (list (cadr x) (caddr x)) coor))
)
)
(entget a)
)
coor
)
页:
[1]
2