[求助]：如何按y坐标分组？

sfjlx

在得到了若干个点坐标后，我想把他们按y坐标相同的分成一个组，那位大虾帮个忙！谢谢！

Underway

依y坐标排序
取出第一个'y坐标',排除非'y坐标'的串列
循环处理

排序的讨论帖请用搜寻.....

zml84

表的操作，可以参照：http://zml84.blog.sohu.com/64522043.html

http://acad.net.cn/viewthread.php?tid=435&extra=page%3D1
这是一个选择集的排序。

taner

http://www.xdcad.net/forum/showthread.php?s=&threadid=463109

sfjlx

非常感谢各位！
我的意思是如何分组，当然排序也是一部分！
比如有100点，有n组y坐标相等，如何把各个点分好组，每组赋值给一个变量，然后返回！

taner

最初由 sfjlx 发布
[B]非常感谢各位！
我的意思是如何分组，当然排序也是一部分！
比如有100点，有n组y坐标相等，如何把各个点分好组，每组赋值给一个变量，然后返回！ [/B]

看看以下如何？

2. 
   
3.   [FONT=courier new]
   
4. (defun test (pts /  lst ylst)
   
5.   (setq pts (vl-sort pts '(lambda (e1 e2)
   
6.                             (if (equal (cadr e1) (cadr e2) 1e-10)
   
7.                               (> (car e1) (car e2))
   
8.                               (> (cadr e1) (cadr e2))
   
9.                             )
   
10.                           )
    
11.             )
    
12.   )
    
13.   (while (> (length pts) 0)
    
14.     (setq lst (cons (setq ylst (th-assoc-y (cadar pts) pts))
    
15.                     lst
    
16.               )
    
17.     )
    
18.     (setq pts (txt-list-subtract pts ylst))
    
19.   )
    
20.   lst
    
21. )
    
22.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun test (pts /  lst ylst)<br />   (setq pts (vl-sort pts '(lambda (e1 e2)<br />                             (if (equal (cadr e1) (cadr e2) 1e-10)<br />                               (> (car e1) (car e2))<br />                               (> (cadr e1) (cadr e2))<br />                             )<br />                           )<br />             )<br />   )<br />   (while (> (length pts) 0)<br />     (setq lst (cons (setq ylst (th-assoc-y (cadar pts) pts))<br />                     lst<br />               )<br />     )<br />     (setq pts (txt-list-subtract pts ylst))<br />   )<br />   lst<br /> )<br />   [/FONT]<br />

子函数

2. 
   
3.   [FONT=courier new]
   
4. (defun th-assoc-y (key alst / i lst)
   
5.   (while (setq i (vl-position key (mapcar
   
6.                                     (function cadr)
   
7.                                     alst
   
8.                                   )
   
9.                  )
   
10.          )
    
11.     (setq lst (cons (nth i alst) lst))
    
12.     (setq alst (txt3-removenth i alst))
    
13.   )
    
14.   lst
    
15. )
    
16. (defun txt3-removenth (n lst / i)      ; 移除列表的第n项
    
17.   (setq j -1)
    
18.   (vl-remove-if '(lambda (x)
    
19.                    (= n (setq j (1+ j)))
    
20.                  ) lst
    
21.   )
    
22. )
    
23. (defun txt-list-subtract (lst1 lst2 / lst);两表差集
    
24.   (setq lst '())
    
25.   (if lst1
    
26.     (progn
    
27.       (foreach tmp lst1
    
28.         (if (not (member tmp lst2))
    
29.           (setq lst (cons tmp lst))
    
30.         )
    
31.       )
    
32.     )
    
33.   )
    
34.   (setq lst (reverse lst))
    
35.   lst
    
36. )
    
37. 
    
38.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun th-assoc-y (key alst / i lst)<br />   (while (setq i (vl-position key (mapcar<br />                                     (function cadr)<br />                                     alst<br />                                   )<br />                  )<br />          )<br />     (setq lst (cons (nth i alst) lst))<br />     (setq alst (txt3-removenth i alst))<br />   )<br />   lst<br /> )<br /> (defun txt3-removenth (n lst / i)      ; 移除列表的第n项<br />   (setq j -1)<br />   (vl-remove-if '(lambda (x)<br />                    (= n (setq j (1+ j)))<br />                  ) lst<br />   )<br /> )<br /> (defun txt-list-subtract (lst1 lst2 / lst);两表差集<br />   (setq lst '())<br />   (if lst1<br />     (progn<br />       (foreach tmp lst1<br />         (if (not (member tmp lst2))<br />           (setq lst (cons tmp lst))<br />         )<br />       )<br />     )<br />   )<br />   (setq lst (reverse lst))<br />   lst<br /> )<br /> <br />   [/FONT]<br />

测试：
命令: !lst
((2074.22 692.04 0.0) (2049.1 1414.48 0.0) (1520.49 1907.55 0.0) (798.047
1882.42 0.0) (304.973 1353.82 0.0) (330.101 631.376 0.0) (858.711 138.302 0.0)
(1581.15 163.43 0.0) (2074.22 692.04 0.0))

命令: (test lst)
(((858.711 138.302 0.0)) ((1581.15 163.43 0.0)) ((330.101 631.376 0.0))
((2074.22 692.04 0.0) (2074.22 692.04 0.0)) ((304.973 1353.82 0.0)) ((2049.1
1414.48 0.0)) ((798.047 1882.42 0.0)) ((1520.49 1907.55 0.0)))