带容差删除重复多段线，写得不好，总感觉太臃肿，请各位看官指点

重慶崽兒

2. (defun c:tt()
   
3.   (setq ss (ssget '((0 . "lwpolyline"))));选择多段线
   
4.   (setq i 1 lst nil);初始化变量,设置i为1的原因是方便j取值
   
5.   (repeat (- (sslength ss) 1);外循环开始,循环次数为多段线个数减1
   
6.     (setq en (entget (ssname ss (- i 1))));得到DXF
   
7.     (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) en)));提取点表
   
8.     (setq lst_ys_x (mapcar 'car (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))));按照X坐标从小到大排序并提取X坐标组成表
   
9.     (setq lst_ys_y (mapcar 'cadr (vl-sort lst '(lambda (e1 e2) (< (cadr e1) (cadr e2))))));按照Y坐标从小到大排序并提取Y坐标组成表
   
10.     (setq j 0);初始化j为0
    
11.     (setq j (+ j i));j的值为i+j
    
12.     (repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i
    
13.       (setq en_1 (entget (ssname ss j)));得到DXF
    
14.       (setq lst_1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) en_1)));提取点表
    
15.       (setq lst_ys_x_1 (mapcar 'car (vl-sort lst_1 '(lambda (e1 e2) (< (car e1) (car e2))))));同样按照X坐标从小到大排序并提取X坐标组成表
    
16.       (setq lst_ys_y_1 (mapcar 'cadr (vl-sort lst_1 '(lambda (e1 e2) (< (cadr e1) (cadr e2))))));同样按照Y坐标从小到大排序并提取Y坐标组成表
    
17.       (if (and (equal lst_ys_x lst_ys_x_1 1e-5) (equal lst_ys_y lst_ys_y_1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除
    
18.         (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object (ssname ss j))));因为已经删除的线会重复删除,所以加错误处理
    
19.       )
    
20.       (setq j (1+ j))
    
21.     );内循环结束
    
22.     (setq i (1+ i))
    
23.   );外循坏结束
    
24.   (princ)
    
25. )

(defun c:tt()<br />   (setq ss (ssget '((0 . "lwpolyline"))));选择多段线<br />   (setq i 1 lst nil);初始化变量,设置i为1的原因是方便j取值<br />   (repeat (- (sslength ss) 1);外循环开始,循环次数为多段线个数减1<br />     (setq en (entget (ssname ss (- i 1))));得到DXF<br />     (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) en)));提取点表<br />     (setq lst_ys_x (mapcar 'car (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))));按照X坐标从小到大排序并提取X坐标组成表<br />     (setq lst_ys_y (mapcar 'cadr (vl-sort lst '(lambda (e1 e2) (< (cadr e1) (cadr e2))))));按照Y坐标从小到大排序并提取Y坐标组成表<br />     (setq j 0);初始化j为0<br />     (setq j (+ j i));j的值为i+j<br />     (repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i<br />       (setq en_1 (entget (ssname ss j)));得到DXF<br />       (setq lst_1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) en_1)));提取点表<br />       (setq lst_ys_x_1 (mapcar 'car (vl-sort lst_1 '(lambda (e1 e2) (< (car e1) (car e2))))));同样按照X坐标从小到大排序并提取X坐标组成表<br />       (setq lst_ys_y_1 (mapcar 'cadr (vl-sort lst_1 '(lambda (e1 e2) (< (cadr e1) (cadr e2))))));同样按照Y坐标从小到大排序并提取Y坐标组成表<br />       (if (and (equal lst_ys_x lst_ys_x_1 1e-5) (equal lst_ys_y lst_ys_y_1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除<br />         (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object (ssname ss j))));因为已经删除的线会重复删除,所以加错误处理<br />       )<br />       (setq j (1+ j))<br />     );内循环结束<br />     (setq i (1+ i))<br />   );外循坏结束<br />   (princ)<br /> )

ZZXXQQ

2. (defun c:tt()
   
3.   (setq ss (ssget '((0 . "LWPOLYLINE"))));选择多段线
   
4.   (setq ress (ssadd))
   
5.   (setq i 0);初始化变量,设置i为1的原因是方便j取值
   
6.   (repeat (1- (sslength ss));外循环开始,循环次数为多段线个数减1
   
7.     (setq ent (entget (ssname ss i)));得到DXF
   
8.     (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent)));提取点表
   
9.     (setq lstx (mapcar 'car (vl-sort lst '(lambda (a b) (< (car a) (car b))))));按照X坐标从小到大排序并提取X坐标组成表
   
10.     (setq lsty (mapcar 'cadr (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b))))));按照Y坐标从小到大排序并提取Y坐标组成表
    
11.     (setq i (1+ i))
    
12.     (setq j i);j的值为i
    
13.     (repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i
    
14.       (setq en (ssname ss j))
    
15.       (setq ent1 (entget en);得到DXF
    
16.       (setq lst1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent1)));提取点表
    
17.       (setq lsx1 (mapcar 'car (vl-sort lst1 '(lambda (a b) (< (car a) (car b))))));同样按照X坐标从小到大排序并提取X坐标组成表
    
18.       (setq lsty1 (mapcar 'cadr (vl-sort lst1 '(lambda (a b) (< (cadr a) (cadr b))))));同样按照Y坐标从小到大排序并提取Y坐标组成表
    
19.       (if (and (equal lstx lstx1 1e-5) (equal lsty lsty1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除
    
20.         (ssadd en ress)
    
21. ;        (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object en)));因为已经删除的线会重复删除,所以加错误处理
    
22.       )
    
23.       (setq j (1+ j))
    
24.     );内循环结束
    
25.   );外循坏结束
    
26.   (if (> (sslength ress) 0) (command "_.ERASE" ress ""))
    
27.   (princ)
    
28. )

(defun c:tt()<br />   (setq ss (ssget '((0 . "LWPOLYLINE"))));选择多段线<br />   (setq ress (ssadd))<br />   (setq i 0);初始化变量,设置i为1的原因是方便j取值<br />   (repeat (1- (sslength ss));外循环开始,循环次数为多段线个数减1<br />     (setq ent (entget (ssname ss i)));得到DXF<br />     (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent)));提取点表<br />     (setq lstx (mapcar 'car (vl-sort lst '(lambda (a b) (< (car a) (car b))))));按照X坐标从小到大排序并提取X坐标组成表<br />     (setq lsty (mapcar 'cadr (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b))))));按照Y坐标从小到大排序并提取Y坐标组成表<br />     (setq i (1+ i))<br />     (setq j i);j的值为i<br />     (repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i<br />       (setq en (ssname ss j))<br />       (setq ent1 (entget en);得到DXF<br />       (setq lst1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent1)));提取点表<br />       (setq lsx1 (mapcar 'car (vl-sort lst1 '(lambda (a b) (< (car a) (car b))))));同样按照X坐标从小到大排序并提取X坐标组成表<br />       (setq lsty1 (mapcar 'cadr (vl-sort lst1 '(lambda (a b) (< (cadr a) (cadr b))))));同样按照Y坐标从小到大排序并提取Y坐标组成表<br />       (if (and (equal lstx lstx1 1e-5) (equal lsty lsty1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除<br />         (ssadd en ress)<br /> ;        (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object en)));因为已经删除的线会重复删除,所以加错误处理<br />       )<br />       (setq j (1+ j))<br />     );内循环结束<br />   );外循坏结束<br />   (if (> (sslength ress) 0) (command "_.ERASE" ress ""))<br />   (princ)<br /> )

重慶崽兒

ZZXXQQ 发表于 2015-6-17 08:35

谢谢Z版  好思路
刚才调试了一下，发现少了个括号，还有就是判断那里变量名少写了个“t”
非常感谢Z版
这个是改后的：

2. (defun c:tt()
   
3.   (setq ss (ssget '((0 . "LWPOLYLINE"))));选择多段线
   
4.   (setq ress (ssadd))
   
5.   (setq i 0);初始化变量,设置i为1的原因是方便j取值
   
6.   (repeat (1- (sslength ss));外循环开始,循环次数为多段线个数减1
   
7.     (setq ent (entget (ssname ss i)));得到DXF
   
8.     (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent)));提取点表
   
9.     (setq lstx (mapcar 'car (vl-sort lst '(lambda (a b) (< (car a) (car b))))));按照X坐标从小到大排序并提取X坐标组成表
   
10.     (setq lsty (mapcar 'cadr (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b))))));按照Y坐标从小到大排序并提取Y坐标组成表
    
11.     (setq i (1+ i))
    
12.     (setq j i);j的值为i
    
13.     (repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i
    
14.       (setq en (ssname ss j))
    
15.       (setq ent1 (entget en));得到DXF
    
16.       (setq lst1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent1)));提取点表
    
17.       (setq lstx1 (mapcar 'car (vl-sort lst1 '(lambda (a b) (< (car a) (car b))))));同样按照X坐标从小到大排序并提取X坐标组成表
    
18.       (setq lsty1 (mapcar 'cadr (vl-sort lst1 '(lambda (a b) (< (cadr a) (cadr b))))));同样按照Y坐标从小到大排序并提取Y坐标组成表
    
19.       (if (and (equal lstx lstx1 1e-5) (equal lsty lsty1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除
    
20.         (ssadd en ress)
    
21. ;        (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object en)));因为已经删除的线会重复删除,所以加错误处理
    
22.       )
    
23.       (setq j (1+ j))
    
24.     );内循环结束
    
25.   );外循坏结束
    
26.   (if (> (sslength ress) 0) (command "_.ERASE" ress ""))
    
27.   (princ)
    
28. )

(defun c:tt()<br />   (setq ss (ssget '((0 . "LWPOLYLINE"))));选择多段线<br />   (setq ress (ssadd))<br />   (setq i 0);初始化变量,设置i为1的原因是方便j取值<br />   (repeat (1- (sslength ss));外循环开始,循环次数为多段线个数减1<br />     (setq ent (entget (ssname ss i)));得到DXF<br />     (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent)));提取点表<br />     (setq lstx (mapcar 'car (vl-sort lst '(lambda (a b) (< (car a) (car b))))));按照X坐标从小到大排序并提取X坐标组成表<br />     (setq lsty (mapcar 'cadr (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b))))));按照Y坐标从小到大排序并提取Y坐标组成表<br />     (setq i (1+ i))<br />     (setq j i);j的值为i<br />     (repeat (- (sslength ss) i);内循坏开始,循坏次数为多段线个数减去i<br />       (setq en (ssname ss j))<br />       (setq ent1 (entget en));得到DXF<br />       (setq lst1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent1)));提取点表<br />       (setq lstx1 (mapcar 'car (vl-sort lst1 '(lambda (a b) (< (car a) (car b))))));同样按照X坐标从小到大排序并提取X坐标组成表<br />       (setq lsty1 (mapcar 'cadr (vl-sort lst1 '(lambda (a b) (< (cadr a) (cadr b))))));同样按照Y坐标从小到大排序并提取Y坐标组成表<br />       (if (and (equal lstx lstx1 1e-5) (equal lsty lsty1 1e-5));对比两个X和两个Y的表看是否一致,一致就删除<br />         (ssadd en ress)<br /> ;        (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object en)));因为已经删除的线会重复删除,所以加错误处理<br />       )<br />       (setq j (1+ j))<br />     );内循环结束<br />   );外循坏结束<br />   (if (> (sslength ress) 0) (command "_.ERASE" ress ""))<br />   (princ)<br /> )

yjc532

已经测试了，非常不错，以前只有删除直线、弧线、圆的程序，还没有多段线的程序。

我有两个建议：
1、增加删除重叠   但不等长的多段线
2、增加设置两个多段线距离非常小的情况下也能删除的功能（这个间距可以由自己设定）

那就完美了

ferious

yjc532 发表于 2015-6-23 20:18
已经测试了，非常不错，以前只有删除直线、弧线、圆的程序，还没有多段线的程序。

我有两个建议：

只能删pl,直线l不行