多段线相邻点除重，得到点表，请大神看看，怎么写更好

重慶崽兒

多段线相邻点除重，得到点表，请大神看看，怎么写更好

2. (defun c:tt()
   
3.   (setq en (entget (car (entsel))))
   
4.   (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) en)))
   
5.   (setq i 0 j 1 pts nil p t)
   
6.   (repeat (length lst)
   
7.     (setq pt (nth i lst))
   
8.     (while p
   
9.       (setq pt_1 (nth j lst))
   
10.       (if (not (equal pt pt_1))
    
11.   (progn
    
12.     (setq pts (append pts (list pt)))
    
13.     (setq i (1+ i))
    
14.     (setq j (1+ j))
    
15.     (setq p nil)
    
16.   )
    
17.   (progn
    
18.     (setq i (1+ i))
    
19.                (setq j (1+ j))
    
20.     (if (> j (length lst))
    
21.                  (setq p nil)
    
22.                )
    
23.   )
    
24.       )
    
25.     )
    
26.     (if (= i (- (length lst) 1))
    
27.       (setq j 0)
    
28.     )
    
29.     (setq p t)
    
30.   )
    
31.   (setq pts (vl-remove-if '(lambda (x) (= x nil)) pts))
    
32.   
    
33. )

(defun c:tt()<br />   (setq en (entget (car (entsel))))<br />   (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) en)))<br />   (setq i 0 j 1 pts nil p t)<br />   (repeat (length lst)<br />     (setq pt (nth i lst))<br />     (while p<br />       (setq pt_1 (nth j lst))<br />       (if (not (equal pt pt_1))<br />   (progn<br />     (setq pts (append pts (list pt)))<br />     (setq i (1+ i))<br />     (setq j (1+ j))<br />     (setq p nil)<br />   )<br />   (progn<br />     (setq i (1+ i))<br />                (setq j (1+ j))<br />     (if (> j (length lst))<br />                  (setq p nil)<br />                )<br />   )<br />       )<br />     )<br />     (if (= i (- (length lst) 1))<br />       (setq j 0)<br />     )<br />     (setq p t)<br />   )<br />   (setq pts (vl-remove-if '(lambda (x) (= x nil)) pts))<br />   <br /> )

USER2128

2. 
   
3. <div class="blockcode"><blockquote>;;; 多段线相邻点除重，得到点表
   
4. ;;; 修改 By USER2128 于 2015-05-24
   
5. (defun c:tt (/ en lst fuzz old)
   
6.   (setq en (entget (car (entsel))))
   
7.   (setq lst (mapcar 'cdr (vl-remove-if '(lambda(x) (/= 10 (car x))) en)))
   
8. ;;; (setq lst '((1 2) (3.3 4.4) (3.3 4.4) (3.3001 4.4001) (5 6) (5 6)))
   
9.   (setq fuzz 0.001)
   
10.   (setq old (last lst))
    
11.   (setq lst (mapcar '(lambda(x) (if (equal x old fuzz) nil (setq old x))) lst))
    
12.   (setq lst (vl-remove 'nil lst))
    
13.   )
    

<br /> <div class="blockcode"><blockquote>;;; 多段线相邻点除重，得到点表<br /> ;;; 修改 By USER2128 于 2015-05-24<br /> (defun c:tt (/ en lst fuzz old)<br />   (setq en (entget (car (entsel))))<br />   (setq lst (mapcar 'cdr (vl-remove-if '(lambda(x) (/= 10 (car x))) en)))<br /> ;;; (setq lst '((1 2) (3.3 4.4) (3.3 4.4) (3.3001 4.4001) (5 6) (5 6)))<br />   (setq fuzz 0.001)<br />   (setq old (last lst))<br />   (setq lst (mapcar '(lambda(x) (if (equal x old fuzz) nil (setq old x))) lst))<br />   (setq lst (vl-remove 'nil lst))<br />   )<br />

zzyong00

还应该考虑有凸度的pl线吧

重慶崽兒

USER2128 发表于 2015-5-24 08:13

非常感谢，太妙了
能否请教下这种情况怎么除重，谢谢：

重慶崽兒

zzyong00 发表于 2015-5-24 17:44
还应该考虑有凸度的pl线吧

额 ，我这边工作倒是不用考虑，因为不会存在有凸度的线的

USER2128

重慶崽兒 发表于 2015-5-24 23:39
非常感谢，太妙了
能否请教下这种情况怎么除重，谢谢：

不适合。如要，可先将原始顶点表按顺（或逆）时针排好序后，再执行我修改的程序部分即可