[编程申请]：删除多段线上的重合点 【完成】

cgl

在绘制多段线时，由于操作失误，在多段线中间或其端点处出现重合点，如何用编程方法将这些多余的重合点删除？

aaddff

养成良好的绘图习惯是很重要的

zhynt

编程思路：
安顺序找出pl线的各顶点，判断一下，如果顶点坐标相同则之保留其一，然后删除原pl线，再用pl线将各顶点连起来。

aeo

;;;我把polyline转成LWpolyline了
;;;命令名aeo,自己改

2. 
   
3. (defun c:aeo (/ dis e j ss del-point-pl)
   
4.   (defun del-point-pl (e dis / a an en how li1 li2 li3 pt pt1 split)
   
5.     (defun split (n li / return a)
   
6.       (while li
   
7.         (setq a nil)
   
8.         (repeat (if (<= n (length li))
   
9.                   n
   
10.                   (length li)
    
11.                 )
    
12.           (setq a (cons (car li) a)
    
13.                 li (cdr li)
    
14.           )
    
15.         )
    
16.         (setq return (cons (reverse a) return))
    
17.       )
    
18.       (reverse return)
    
19.     )
    
20.     (setq en (entget e '("*"))
    
21.           how nil
    
22.     )
    
23.     (foreach an en
    
24.       (if (setq a (member (car an) '(10 40 41 42)))
    
25.         (setq how t)
    
26.       )
    
27.       (cond
    
28.         ((not how)
    
29.           (setq li1 (cons an li1))
    
30.         )
    
31.         ((and
    
32.            how
    
33.            a
    
34.          )
    
35.           (setq li2 (cons an li2))
    
36.         )
    
37.         (t
    
38.           (setq li3 (cons an li3))
    
39.         )
    
40.       )
    
41.     )
    
42.     (setq li1 (reverse li1)
    
43.           li2 (reverse li2)
    
44.           li3 (reverse li3)
    
45.           li2 (split 4 li2)
    
46.           li1 (append
    
47.                 li1
    
48.                 (car li2)
    
49.               )
    
50.           pt (cdaar li2)
    
51.           li2 (cdr li2)
    
52.     )
    
53.     (foreach p li2
    
54.       (setq pt1 (cdar p))
    
55.       (if (> (distance pt pt1) dis)
    
56.         (setq li1 (append
    
57.                     li1
    
58.                     p
    
59.                   )
    
60.         )
    
61.       )
    
62.       (setq pt pt1)
    
63.     )
    
64.     (entmod (append
    
65.               li1
    
66.               li3
    
67.             )
    
68.     )
    
69.   )                                       ; **
    
70.   (setq j -1)
    
71.   (if (setq ss (ssget '((0 . "*POLYLINE"))))
    
72.     (progn
    
73.       (setq dis (getdist "\n多少距离之间要删除(0.001)"))
    
74.       (if (not dis)
    
75.         (setq dis 1e-3)
    
76.       )
    
77.       (command "undo" "group")
    
78.       (repeat (sslength ss)
    
79.         (setq e (ssname ss (setq j (1+ j))))
    
80.         (if (= "POLYLINE" (cdr (assoc 0 (entget e))))
    
81.           (command "convert" "p" "s" e "")
    
82.         )
    
83.         (if (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
    
84.           (del-point-pl e dis)
    
85.         )
    
86.       )
    
87.       (command "undo" "end")
    
88.     )
    
89.   )
    
90.   (princ)
    
91. )
    

<br /> (defun c:aeo (/ dis e j ss del-point-pl)<br />   (defun del-point-pl (e dis / a an en how li1 li2 li3 pt pt1 split)<br />     (defun split (n li / return a)<br />       (while li<br />         (setq a nil)<br />         (repeat (if (<= n (length li))<br />                   n<br />                   (length li)<br />                 )<br />           (setq a (cons (car li) a)<br />                 li (cdr li)<br />           )<br />         )<br />         (setq return (cons (reverse a) return))<br />       )<br />       (reverse return)<br />     )<br />     (setq en (entget e '("*"))<br />           how nil<br />     )<br />     (foreach an en<br />       (if (setq a (member (car an) '(10 40 41 42)))<br />         (setq how t)<br />       )<br />       (cond<br />         ((not how)<br />           (setq li1 (cons an li1))<br />         )<br />         ((and<br />            how<br />            a<br />          )<br />           (setq li2 (cons an li2))<br />         )<br />         (t<br />           (setq li3 (cons an li3))<br />         )<br />       )<br />     )<br />     (setq li1 (reverse li1)<br />           li2 (reverse li2)<br />           li3 (reverse li3)<br />           li2 (split 4 li2)<br />           li1 (append<br />                 li1<br />                 (car li2)<br />               )<br />           pt (cdaar li2)<br />           li2 (cdr li2)<br />     )<br />     (foreach p li2<br />       (setq pt1 (cdar p))<br />       (if (> (distance pt pt1) dis)<br />         (setq li1 (append<br />                     li1<br />                     p<br />                   )<br />         )<br />       )<br />       (setq pt pt1)<br />     )<br />     (entmod (append<br />               li1<br />               li3<br />             )<br />     )<br />   )                                       ; **<br />   (setq j -1)<br />   (if (setq ss (ssget '((0 . "*POLYLINE"))))<br />     (progn<br />       (setq dis (getdist "\n多少距离之间要删除(0.001)"))<br />       (if (not dis)<br />         (setq dis 1e-3)<br />       )<br />       (command "undo" "group")<br />       (repeat (sslength ss)<br />         (setq e (ssname ss (setq j (1+ j))))<br />         (if (= "POLYLINE" (cdr (assoc 0 (entget e))))<br />           (command "convert" "p" "s" e "")<br />         )<br />         (if (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))<br />           (del-point-pl e dis)<br />         )<br />       )<br />       (command "undo" "end")<br />     )<br />   )<br />   (princ)<br /> )<br />

狂刀

ａｅｏ，有没有删除同方向点的？（在一段直段上有多点）

eachy

2006 就简单了，Explode-〉逐一 Join-〉Pedit 连接

狂刀

最初由 eachy 发布
[B]2006 就简单了，Explode-〉逐一 Join-〉Pedit 连接 [/B]

炸开宽度信息就丢失了,如果各段不等宽或带扩展数据....也丢失了

eachy

你删除顶点就没有丢失上述信息的可能？