[求助]：恳请大虾出手_列表的问题

mhy007

怎样提取一个点的列表里面，X轴相同，而Y轴的差值的绝对值为8的点组成一个或多个新列表？
例如列表'((150.0 286.0 0.0)(150.0 302.0 0.0)(450.0 236.5 0.0)(450.0 397.0 0.0)(150.0 294.0 0.0)(580.0 286.0 0.0)(450.0 244.5 0.0)(150.0 480.6 0.0)(580.0 294.0 0.0)(230.0 286.0 0.0)(580.0 302.0 0.0))就应该能提取出'((150.0 286.0 0.0)(150.0 294.0 0.0)(150.0 302.0 0.0))'((450.0 236.5 0.0)(450.0 244.5 0.0))'((580.0 286.0 0.0)(580.0 294.0 0.0)(580.0 302.0 0.0))这三个列表,想破了脑袋也没有头绪,只好再请各位大虾出手了

雨箭风刀

vl-remov-if 加 equal使用

Free-Lancer

最初由 mhy007 发布
[B]怎样提取一个点的列表里面，X轴相同，而Y轴的差值的绝对值为8的点组成一个或多个新列表？
例如列表'((150.0 286.0 0.0)(150.0 302.0 0.0)(450.0 236.5 0.0)(450.0 397.0 0.0)(150.0 294.0 0.0)(580.0 286.0 0.0)(45... [/B]

2. 
   
3. (defun sortpts (pts / pl)
   
4.   (setq        pts (vl-sort pts
   
5.                      '(lambda (p1 p2)
   
6.                         (if (equal (car p1) (car p2) 1e-8)
   
7.                           (< (cadr p1) (cadr p2))
   
8.                           (< (car p1) (car p2))
   
9.                         )
   
10.                       )
    
11.             )
    
12.   )
    
13.   (foreach p pts
    
14.     (if        pl
    
15.       (if (and (equal (car p) (caaar pl) 1e-8)
    
16.                (equal (abs (- (cadaar pl) (cadr p))) 8. 1e-8)
    
17.           )
    
18.         (setq pl (cons (cons p (car pl)) (cdr pl)))
    
19.         (setq pl (cons (list p) pl))
    
20.       )
    
21.       (setq pl (cons (list p) pl))
    
22.     )
    
23.   )
    
24.   (vl-remove-if '(lambda (x) (= (length x) 1)) pl)
    
25. )

<br /> (defun sortpts (pts / pl)<br />   (setq        pts (vl-sort pts<br />                      '(lambda (p1 p2)<br />                         (if (equal (car p1) (car p2) 1e-8)<br />                           (< (cadr p1) (cadr p2))<br />                           (< (car p1) (car p2))<br />                         )<br />                       )<br />             )<br />   )<br />   (foreach p pts<br />     (if        pl<br />       (if (and (equal (car p) (caaar pl) 1e-8)<br />                (equal (abs (- (cadaar pl) (cadr p))) 8. 1e-8)<br />           )<br />         (setq pl (cons (cons p (car pl)) (cdr pl)))<br />         (setq pl (cons (list p) pl))<br />       )<br />       (setq pl (cons (list p) pl))<br />     )<br />   )<br />   (vl-remove-if '(lambda (x) (= (length x) 1)) pl)<br /> )

mhy007

这么多的代码，楼上的辛苦了，谢谢。还没有仔细研究，不过运行了一下，提示：参数太少。不知为什么。

Underway

(setq Pts '((150.0 286.0 0.0)(150.0 302.0 0.0)(450.0 236.5 0.0)(450.0 397.0 0.0)(150.0 294.0 0.0)(580.0 286.0 0.0)(450.0 244.5 0.0)(150.0 480.6 0.0)(580.0 294.0 0.0)(230.0 286.0 0.0)(580.0 302.0 0.0)))

(sortpts pts)

fsxm

这个应该不难的！
代码也用不了那么多！