运行lisp后，多边形变为另一个形状。我认为这和VVA说的一样，很难确定需要保留哪一点。
LWPOLYLINE空间：模型空间
手柄=2cab
关闭
恒定宽度0.00
面积14153723.23
周长21581.35
点X=-9771.00 Y=-7388.00 Z=0.00
点X=-9771.00 Y=-7388.00 Z=0.00
点X=-8116.00 Y=-9826.00 Z=0.00
点X=-9771.00 Y=-7388.00 Z=0.00
点X=-13222.00 Y=-11647.00 Z=0.00
点X=-10528.48 Y=-13202.10 Z=0.00
点X=-8116.00 Y=-9826.00 Z=0.00
LW多段线
空间：模型空间
颜色：9线型：“BYLAYER”
手柄=2da0
关闭
恒定宽度0.00
面积6952768.87
周长17341.12
点X=-9771.00 Y=-7388.00 Z=0.00
点X=-8116.00 Y=-9826.00 Z=0.00
点X=-13222.00 Y=-11647.00 Z=0.00
点X=-10528.48 Y=-13202.10 Z=0.00
让我详细解释一下我的情况。虽然这是一条闭合的多段线，但一条线段内部有两条重叠的直线。有一些重复点显示重叠位置。我想使用lisp检查多段线，如果发现任何重复的线，它会自动删除它。如果难以确定需要保留哪些直线/点，是否可以显示哪些多段线仅具有此重叠。
谢谢 这将选择具有重复点的所有LWD多段线：
(defun c:test ( / LM:UniqueFuzz LM:MAssoc ss i e ) (vl-load-com)
;; © Lee Mac 2011
(defun LM:UniqueFuzz-p ( lst fuzz )
(or (null lst)
(and (not (vl-member-if '(lambda ( x ) (equal x (car lst) fuzz)) (cdr lst)))
(LM:UniqueFuzz-p (cdr lst) fuzz)
)
)
)
(defun LM:MAssoc ( key lst / pair )
(if (setq pair (assoc key lst))
(cons (cdr pair) (LM:MAssoc key (cdr (member pair lst))))
)
)
(if (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength ss))
(if (LM:UniqueFuzz-p (LM:MAssoc 10 (entget (setq e (ssname ss (setq i (1- i)))))) 1e-
(ssdel e ss)
)
)
)
(sssetfirst nil ss)
(princ)
) 试试看
(defun c:testVVA (/ UniqueLineFuzzss i el ss1 lst1)
(vl-load-com)
(defun UniqueLineFuzz (lst fuzz)
(if lst
(cons
(car lst)
(UniqueLineFuzz
(vl-remove-if
'(lambda (x)
(apply 'and
(mapcar '(lambda (l1 l2 / sl1 el1 sl2 el2)
(setq
sl1 (mapcar '+
(vlax-curve-getstartpoint l1)
'(0 0)
) ;_ end of mapcar
el1 (mapcar '+
(vlax-curve-getendpoint l1)
'(0 0)
) ;_ end of mapcar
sl2 (mapcar '+
(vlax-curve-getstartpoint l2)
'(0 0)
) ;_ end of mapcar
el2 (mapcar '+
(vlax-curve-getendpoint l2)
'(0 0)
) ;_ end of mapcar
) ;_ end of setq
(or
(and
(equal (car sl1) (car sl2) fuzz)
(equal (cadr sl1) (cadr sl2) fuzz)
(equal (car el1) (car el2) fuzz)
(equal (cadr el1) (cadr el2) fuzz)
) ;_ end of and
(and
(equal (car sl1) (car el2) fuzz)
(equal (cadr sl1) (cadr el2) fuzz)
(equal (car el1) (car sl2) fuzz)
(equal (cadr el1) (cadr sl2) fuzz)
) ;_ end of and
) ;_ end of or
) ;_ end of lambda
(list x)
lst
) ;_ end of mapcar
) ;_ end of apply
) ;_ end of lambda
(cdr lst)
) ;_ end of vl-remove-if
fuzz
) ;_ end of LM:UniqueSegFuzz
) ;_ end of cons
) ;_ end of if
) ;_ end of defun
(if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength ss))
(setq el (ssname ss (setq i (1- i))))
(setq lst (vlax-safearray->list
(vlax-variant-value
(vla-explode (vlax-ename->vla-object el))
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
lst (vl-remove-if '(lambda (x)(equal (vlax-curve-getDistAtParam x(vlax-curve-getEndParam x)) 0.0 1e-6)) lst)
) ;_ end of setq
(setq lst1
(mapcar 'vlax-vla-object->ename (UniqueLineFuzz lst 1e-6))
) ;_ end of setq
(setq ss1 (ssadd (car lst1)))
(mapcar '(lambda (x) (ssadd x ss1)) (cdr lst1))
(if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
(vl-cmdf "_pedit" "_Multiple" ss1 "" "_Join" 0 "")
(vl-cmdf "_pedit" "_Multiple" ss1 "" "_Y" "_Join" 0 "")
) ;_ end of if
(entdel el)
(mapcar '(lambda (x)
(if (not (vlax-erased-p x))
(vla-delete x)
) ;_ end of if
) ;_ end of lambda
lst
) ;_ end of mapcar
) ;_ end of repeat
) ;_ end of if
(princ)
) ;_ end of defun
谢谢你的代码李Mac！
非常感谢您的帮助VVA，这段代码正在运行！再次感谢VVA和李·麦克的友好协助。
我尝试在多段线上使用此lisp，程序返回以下错误消息：
ActiveX服务器返回错误：未知名称：长度
它只在网上工作吗？ 正确#13（多么幸运）重试 VVA，只是好奇，为什么：
(mapcar '+ < .. >'(0 0))
显然，（0 0）不会以任何方式影响结果，因此您是否使用此方法来确保从mapcar返回的是2D点？ 我相信李不会介意的：
它广泛使用递归。。。你会在lisp中找到很多东西。一、 e.以形成循环的方式调用自身的函数。这有时比使用正常的while/repeat/etc.循环更好/更容易/更有效。在上述情况下，这是其中之一。
还请注意Lee从最后一个实体开始逐步遍历列表-递减i（index）变量。这背后有两个原因：（1）它的效率略高于另一种方式；（2）因为他正在从选择集中删除元素，所以长度会发生变化-因此，如果删除#4，则旧的#5会成为新的#4，因此增加值我会跳过一些项目。
页:
1
[2]