首尾连接但不闭合的多段线如何使之闭合

llsheng_73

1. (defun closepline(e / en c70 e2);;去除多段线首尾重合点并闭合
   
2.   (setq en(entget e)c70(cdr(assoc 70 en))e2(reverse en))
   
3.   (if(equal(vlax-curve-getstartpoint e)
   
4.            (vlax-curve-getpointatparam e(1-(cdr(assoc 90 en))))1e-8)
   
5.     (progn
   
6.       (vl-every'(lambda(x)(if(/=(car x)10)(setq e2(cdr e2))))e2)
   
7.       (entmod(subst(cons 70(logior c70 1))(cons 70 c70)
   
8.                    (append(reverse(cdr e2))(List(assoc 210 en))))
   
9.                    ))))

(defun closepline(e / en c70 e2);;去除多段线首尾重合点并闭合<br />   (setq en(entget e)c70(cdr(assoc 70 en))e2(reverse en))<br />   (if(equal(vlax-curve-getstartpoint e)<br />            (vlax-curve-getpointatparam e(1-(cdr(assoc 90 en))))1e-8)<br />     (progn<br />       (vl-every'(lambda(x)(if(/=(car x)10)(setq e2(cdr e2))))e2)<br />       (entmod(subst(cons 70(logior c70 1))(cons 70 c70)<br />                    (append(reverse(cdr e2))(List(assoc 210 en))))<br />                    ))))

丶吟游诗人灬

感谢楼主分享，有空研究一下

weijiewen

请问楼主解决了嘛？

Pegasus

KO你 发表于 2020-4-22 16:00
在论坛上就能找到
快捷键  qdd  多段线顶点优化
(defun c:qdd(/ om ss l_length i j n mm z data new_l ...

有一个BUG。如果多段线的各段都在一条直线上，代码运行结果是删除了该多段线。