消去表中相同坐标

xjf

         记得有一个大侠写的X-sort  ,能消去重复的X坐标，现找不到了

690994

点出错一般是电脑问题，在电脑取点时显示器是一样，但电脑里可能不是一样的，可能有0.0000000000001之类精度误差，我一般在取得点时先将XY值按自己要的精度四舍五入下理一下才消重排序，这样不会出错。

Gu_xl

点表除重要考虑容差问题,下面代码是递归方法除重：

1. ;;;参数 (ptLst = 点表  fuzz = 容差
   
2. (defun DumpPoint (ptLst fuzz / pt1 x)
   
3. (cond ((<= (length ptLst)1) ptLst)
   
4.        (t (setq pt1 (car ptLst))
   
5.          (cons pt1 (vl-remove-if '(lambda(x)(equal pt1 x fuzz))
   
6.                (DumpPoint (cdr ptLst) fuzz))
   
7.          )
   
8.      ))
   
9. )
   

;;;参数 (ptLst = 点表  fuzz = 容差<br /> (defun DumpPoint (ptLst fuzz / pt1 x)<br /> (cond ((<= (length ptLst)1) ptLst)<br />        (t (setq pt1 (car ptLst))<br />          (cons pt1 (vl-remove-if '(lambda(x)(equal pt1 x fuzz))<br />                (DumpPoint (cdr ptLst) fuzz))<br />          )<br />      ))<br /> )<br />

xjf

    请问楼上版主，如果我只要消去相同的X坐标(X相同的点只要一个)的有什么好方法

如    (x-sort '((18 20)  (40 15)  (18 50)  (30 50)  (40 25))) → '((18 20) (30 50) (40 15));;; 此项OK

  和((-1913.6 24973.7) (-1913.6 24989.4)) ;此项NG
我下的X-sort 很不稳定，有时能消有时不能消,而且要X相同,Y最小的保留)

xjf

       试了一下,下面改的不行


(setq ptLst '((25089.7 -1754.14 0.0) (25066.9 -1762.19 0.0)
            (25089.7 -1754.14 0.0) (25081.1 -1759.79 0.0)
            (25071.4 -1751.72 0.0) (25071.4 -1751.72 0.0)) )

(defun DumpPointx (ptLst fuzz / pt1 x)
(cond ((<= (length ptLst)1) ptLst)
       (t (setq ptn (car (setq pt1 (car ptLst))))
         (cons pt1 (vl-remove-if '(lambda(x)(if (equal ptn (car x) fuzz) x))
               (DumpPointx (cdr ptLst) fuzz))
         )
     ))
)

(DumpPointx ptLst 2)

Gu_xl

xjf 发表于 2011-12-20 08:20
试了一下,下面改的不行

1. ;;;消去相同的X坐标,且Y最小的保留
   
2. ;;;(dumpx '((18 20)  (40 15)  (18 50)  (30 50)  (40 25)) 0.01)
   
3. (defun dumpx (PL FUZZ / DUMPPOINT)
   
4.   ;;;除X相同点
   
5.   (defun DumpPoint (ptLst fuzz / pt1)
   
6.     (cond ((<= (length ptLst) 1) ptLst)
   
7.           (t
   
8.            (setq pt1 (car ptLst))
   
9.            (cons pt1
   
10.                  (vl-remove-if
    
11.                    '(lambda (x) (equal (car pt1) (car x) fuzz))
    
12.                    (DumpPoint (cdr ptLst) fuzz)
    
13.                  )
    
14.            )
    
15.           )
    
16.     )
    
17.   )
    
18.    
    
19.   (setq pl (vl-sort pl '(lambda (a b) (< (cadr a) (cadr b))))) ;_ 按Y从小到大排序
    
20.   (setq pl (DumpPoint pl 0.01))
    
21.   (vl-sort pl '(lambda (a b) (< (car a) (car b)))) ;_ 按X从小到大排序
    
22.   )
    

;;;消去相同的X坐标,且Y最小的保留<br /> ;;;(dumpx '((18 20)  (40 15)  (18 50)  (30 50)  (40 25)) 0.01)<br /> (defun dumpx (PL FUZZ / DUMPPOINT)<br />   ;;;除X相同点<br />   (defun DumpPoint (ptLst fuzz / pt1)<br />     (cond ((<= (length ptLst) 1) ptLst)<br />           (t<br />            (setq pt1 (car ptLst))<br />            (cons pt1<br />                  (vl-remove-if<br />                    '(lambda (x) (equal (car pt1) (car x) fuzz))<br />                    (DumpPoint (cdr ptLst) fuzz)<br />                  )<br />            )<br />           )<br />     )<br />   )<br />    <br />   (setq pl (vl-sort pl '(lambda (a b) (< (cadr a) (cadr b))))) ;_ 按Y从小到大排序<br />   (setq pl (DumpPoint pl 0.01)) <br />   (vl-sort pl '(lambda (a b) (< (car a) (car b)))) ;_ 按X从小到大排序<br />   )<br />

xjf

              麻烦大侠解说下以下的和您的有什么不同, 还有怎样才能高亮呢??

   (defun DumpPoint (ptLst fuzz / pt1 x)
     (cond ((<= (length ptLst)1) ptLst)
       (t
        (setq ptn (car (setq pt1 (car ptLst))))
         (cons pt1
               (vl-remove-if
                 '(lambda(x) (equal ptn (car x) fuzz))
               (DumpPoint (cdr ptLst) fuzz))
         )
     ))
)

zdqwy19

可以先排除重复点，在排序