带容差删除重复多段线，写得不好，总感觉太臃肿，请各位看官指点
(defun c:tt()(setq ss (ssget '((0 . "lwpolyline"))));选择多段线
(setq i 1 lst nil);初始化变量,设置i为1的原因是方便j取值
(repeat (- (sslength ss) 1);外循环开始,循环次数为多段线个数减1
(setq en (entget (ssname ss (- i 1))));得到DXF
(setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) en)));提取点表
(setq lst_ys_x (mapcar 'car (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))));按照X坐标从小到大排序并提取X坐标组成表
(setq lst_ys_y (mapcar 'cadr (vl-sort lst '(lambda (e1 e2) (< (cadr e1) (cadr e2))))));按照Y坐标从小到大排序并提取Y坐标组成表
(setq j 0);初始化j为0
(setq j (+ j i));j的值为i+j
(repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i
(setq en_1 (entget (ssname ss j)));得到DXF
(setq lst_1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) en_1)));提取点表
(setq lst_ys_x_1 (mapcar 'car (vl-sort lst_1 '(lambda (e1 e2) (< (car e1) (car e2))))));同样按照X坐标从小到大排序并提取X坐标组成表
(setq lst_ys_y_1 (mapcar 'cadr (vl-sort lst_1 '(lambda (e1 e2) (< (cadr e1) (cadr e2))))));同样按照Y坐标从小到大排序并提取Y坐标组成表
(if (and (equal lst_ys_x lst_ys_x_1 1e-5) (equal lst_ys_y lst_ys_y_1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除
(vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object (ssname ss j))));因为已经删除的线会重复删除,所以加错误处理
)
(setq j (1+ j))
);内循环结束
(setq i (1+ i))
);外循坏结束
(princ)
) (defun c:tt()
(setq ss (ssget '((0 . "LWPOLYLINE"))));选择多段线
(setq ress (ssadd))
(setq i 0);初始化变量,设置i为1的原因是方便j取值
(repeat (1- (sslength ss));外循环开始,循环次数为多段线个数减1
(setq ent (entget (ssname ss i)));得到DXF
(setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent)));提取点表
(setq lstx (mapcar 'car (vl-sort lst '(lambda (a b) (< (car a) (car b))))));按照X坐标从小到大排序并提取X坐标组成表
(setq lsty (mapcar 'cadr (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b))))));按照Y坐标从小到大排序并提取Y坐标组成表
(setq i (1+ i))
(setq j i);j的值为i
(repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i
(setq en (ssname ss j))
(setq ent1 (entget en);得到DXF
(setq lst1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent1)));提取点表
(setq lsx1 (mapcar 'car (vl-sort lst1 '(lambda (a b) (< (car a) (car b))))));同样按照X坐标从小到大排序并提取X坐标组成表
(setq lsty1 (mapcar 'cadr (vl-sort lst1 '(lambda (a b) (< (cadr a) (cadr b))))));同样按照Y坐标从小到大排序并提取Y坐标组成表
(if (and (equal lstx lstx1 1e-5) (equal lsty lsty1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除
(ssadd en ress)
; (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object en)));因为已经删除的线会重复删除,所以加错误处理
)
(setq j (1+ j))
);内循环结束
);外循坏结束
(if (> (sslength ress) 0) (command "_.ERASE" ress ""))
(princ)
) ZZXXQQ 发表于 2015-6-17 08:35 static/image/common/back.gif
谢谢Z版好思路
刚才调试了一下，发现少了个括号，还有就是判断那里变量名少写了个“t”
非常感谢Z版
这个是改后的：(defun c:tt()
(setq ss (ssget '((0 . "LWPOLYLINE"))));选择多段线
(setq ress (ssadd))
(setq i 0);初始化变量,设置i为1的原因是方便j取值
(repeat (1- (sslength ss));外循环开始,循环次数为多段线个数减1
(setq ent (entget (ssname ss i)));得到DXF
(setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent)));提取点表
(setq lstx (mapcar 'car (vl-sort lst '(lambda (a b) (< (car a) (car b))))));按照X坐标从小到大排序并提取X坐标组成表
(setq lsty (mapcar 'cadr (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b))))));按照Y坐标从小到大排序并提取Y坐标组成表
(setq i (1+ i))
(setq j i);j的值为i
(repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i
(setq en (ssname ss j))
(setq ent1 (entget en));得到DXF
(setq lst1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent1)));提取点表
(setq lstx1 (mapcar 'car (vl-sort lst1 '(lambda (a b) (< (car a) (car b))))));同样按照X坐标从小到大排序并提取X坐标组成表
(setq lsty1 (mapcar 'cadr (vl-sort lst1 '(lambda (a b) (< (cadr a) (cadr b))))));同样按照Y坐标从小到大排序并提取Y坐标组成表
(if (and (equal lstx lstx1 1e-5) (equal lsty lsty1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除
(ssadd en ress)
; (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object en)));因为已经删除的线会重复删除,所以加错误处理
)
(setq j (1+ j))
);内循环结束
);外循坏结束
(if (> (sslength ress) 0) (command "_.ERASE" ress ""))
(princ)
) 已经测试了，非常不错，以前只有删除直线、弧线、圆的程序，还没有多段线的程序。
我有两个建议：
1、增加删除重叠 但不等长的多段线
2、增加设置两个多段线距离非常小的情况下也能删除的功能（这个间距可以由自己设定）
那就完美了 yjc532 发表于 2015-6-23 20:18
已经测试了，非常不错，以前只有删除直线、弧线、圆的程序，还没有多段线的程序。
我有两个建议：
只能删pl,直线l不行
页:
[1]