[求助]：如何对坐标点排序？

ykklms

想请教各位高手：如何对所取得的一组坐标点进行排序，如((911.102 286.647 0.0) (795.308 271.554 0.0) (650.985 253.108 0.0) (474.777 264.847 0.0) (375.764 326.895 0.0) (285.143 387.266 0.0))
按X和Y分别排序(从小到大)，取得二组点表，同时去掉重复的点，并且对X进行排序时去掉X值相同的点，对Y进行排序时去掉Y值相同的点。
请高手不吝赐教。

eachy

最初由 ykklms 发布
[B]想请教各位高手：如何对所取得的一组坐标点进行排序，如((911.102 286.647 0.0) (795.308 271.554 0.0) (650.985 253.108 0.0) (474.777 264.847 0.0) (375.764 326.895 0.0) (285.143 387.266 0.0))
按X和Y分别排?.. [/B]

xdrx_api中用于排序的几个函数。

1. 
   
2. [color=blur]xdrx_realsort1[/color]
   
3. 
   
4. 功    能：对给定的一组整(实数)从小到大排升序,省略重复项。
   
5. 
   
6. 调用格式：(xdrx_realsort1 < 数1 > < 数2 > ... [数n])
   
7. 
   
8. 返 回 值：返回排序后的表。
   
9. 
   
10. 示    例：a='(3 4.6 56.0 2.1 4.6)
    
11.             (apply 'xdrx_realsort1 a)
    
12.             返回：(2.1 3.0 4.6 56.0)
    
13. 
    
14. [color=blue]xdrx_realsort2[/color]
    
15. 
    
16. 功    能：对给定的一组整(实数)从小到大排升序,不省略重复项。
    
17. 
    
18. 调用格式：(xdrx_realsort2 < 数1 > < 数2 > ... [数n])
    
19. 
    
20. 返 回 值：返回排序后的表。
    
21. 
    
22. 示    例：a='(3 4.6 56.0 2.1 4.6)
    
23.             (apply 'xdrx_realsort1 a)
    
24.             返回：(2.1 3.0 4.6 4.6 56.0)
    
25. 
    
26. [color=blue]xdrx_rlistdel1[/color]
    
27. 
    
28. 功    能：根据关联表的索引值，把关联表中和给定的索引值相同的项删除。不省略重复项。凡是相等的都删除。
    
29. 
    
30. 调用格式：(xdrx_rlistdel1 < 索引值 > < 关联表项1 > < 关联表项1 > ... [关联表项n])
    
31. 
    
32. 返 回 值：返回表。
    
33. 
    
34. 示    例：将关联表a='((3 "a" "b")(5 ("a" "c"))(3 (2 3)))中索引值为3的关联表项删除
    
35.             (apply 'xdrx_rlistdel1 (cons 3 a))
    
36.             返回值为：'((5 ("a" "c")))
    
37. 
    
38. [color=blue]xdrx_rlistdel2[/color]
    
39. 
    
40. 功    能：根据关联表的索引值，把关联表中和给定的索引值相同的项删除。省略重复项。只删除第一个相等的关联表项。
    
41. 
    
42. 调用格式：(xdrx_rlistdel2 < 索引值 > < 关联表项1 > < 关联表项1 > ... [关联表项n])
    
43. 
    
44. 返 回 值：返回表。
    
45. 
    
46. 示    例：将关联表a='((3 "a" "b")(5 ("a" "c"))(3 (2 3)))中索引值为3的关联表项删除
    
47.             (apply 'xdrx_rlistdel1 (cons 3 a))
    
48.             返回值为：'((5 ("a" "c"))(3 (2 3)))
    
49. 
    
50. [color=blue]xdrx_rlistsort1[/color]
    
51. 
    
52. 功    能：根据关联表的索引值，把关联表从小到大排升序,省略重复项。
    
53. 
    
54. 调用格式：(xdrx_rlistsort1 < 关联表项1 > < 关联表项1 > ... [关联表项n])
    
55. 
    
56. 返 回 值：返回排序后的表。
    
57. 
    
58. 示    例：a='((34.0 "a")(2.0 (2 3))(34 ("a" "b")))
    
59.             (apply 'xdrx_rlistsort2 a)
    
60.             返回值：((2.0 (2.0 3.0)) (34 ("a" "b")))
    
61. 
    
62. [color=blue]xdrx_rlistsort2[/color]
    
63. 
    
64. 功    能：根据关联表的索引值，把关联表从小到大排升序,不省略重复项。
    
65. 
    
66. 调用格式：(xdrx_rlistsort2 < 关联表项1 > < 关联表项1 > ... [关联表项n])
    
67. 
    
68. 返 回 值：返回排序后的表。
    
69. 
    
70. 示    例：a='((34.0 "a")(2.0 (2 3))(34 ("a" "b")))
    
71.             (apply 'xdrx_rlistsort2 a)
    
72.             返回值：((2.0 (2.0 3.0)) (34 ("a" "b")) (34.0 "a"))
    

复制代码

还有一个更实用的

2. 
   
3. xdrx_SortPointOnCurve
   
4. 
   
5. 功    能：基于实体的点的排序函数，就是有一系列点是在曲线实体上，基于这个曲线实体，
   
6. 
   
7.           从开始点到结束点排序这些实体上的点。结果是这些点依据实体的开始点开始排升序。
   
8. 
   
9. 调用格式：(xdrx_SortPointOnCurve  < 曲线实体名 > ptl]
   
10. 
    
11. 返 回 值：以曲线实体的开始参数为基点，排升序后的表。
    
12. 
    
13. 例    子： 该函数在求一个曲线和其他所有曲线的交点的时候，很常用。
    
14.             如：求一个已经的ARC和一些曲线实体的交点，然后为了下面的操作需要讲这些得到的交点
    
15.                 排序，以前的做法是得到交点后，还需要根据某个特征，如求这些点到一个图形最小点
    
16.                 的距离等等作为依据，排序。（这种方法的缺点就是若第一个曲线参数不是LINE，而是ARC
    
17.                 等曲线，那么就非常不容易排序。现在有这个函数，问题就很好解决了。
    
18. 
    
19.     (setq e (car (xdrx_entsel "\n请选取一个曲线实体:" '((0 . "*line,arc,ellipse")))));;得到一个曲线
    
20.     (setq ptl (xdrx_getsamplept e)) ;;得到这个曲线的模拟顶点表
    
21.     (setq ss (ssget "f" ptl '((0 . "*line,arc,ellipse")))) ;;得到所有和这个曲线相交的曲线实体到选择集ss
    
22.     (setq ptl (xdrx_getinters e ss)) ;;得到曲线E和选择集中所有曲线的实际交点，不延伸。
    
23.     (setq p (cons e ptl)) ;;构造基于实体排序的函数xdrx_SortPointOnCurve的参数表
    
24.     (setq ptl (xdrx_sortpointoncurve e p)) ;;得到了排序后的点。
    
25. 
    
26.     这些功能若不用XDRX_API,只用LISP，要用几十倍的代码量才能完成。
    
27. 
    
28.     这些代码在求如建筑上轴网交点等等操作，极大的简化了代码量，速度还很快。
    
29. 
    
30.     可以求任意实体的交点和排序。
    

<br /> xdrx_SortPointOnCurve<br /> <br /> 功    能：基于实体的点的排序函数，就是有一系列点是在曲线实体上，基于这个曲线实体，<br /> <br />           从开始点到结束点排序这些实体上的点。结果是这些点依据实体的开始点开始排升序。<br /> <br /> 调用格式：(xdrx_SortPointOnCurve  < 曲线实体名 > ptl]<br /> <br /> 返 回 值：以曲线实体的开始参数为基点，排升序后的表。<br /> <br /> 例    子： 该函数在求一个曲线和其他所有曲线的交点的时候，很常用。<br />             如：求一个已经的ARC和一些曲线实体的交点，然后为了下面的操作需要讲这些得到的交点<br />                 排序，以前的做法是得到交点后，还需要根据某个特征，如求这些点到一个图形最小点<br />                 的距离等等作为依据，排序。（这种方法的缺点就是若第一个曲线参数不是LINE，而是ARC<br />                 等曲线，那么就非常不容易排序。现在有这个函数，问题就很好解决了。<br /> <br />     (setq e (car (xdrx_entsel "\n请选取一个曲线实体:" '((0 . "*line,arc,ellipse")))));;得到一个曲线<br />     (setq ptl (xdrx_getsamplept e)) ;;得到这个曲线的模拟顶点表<br />     (setq ss (ssget "f" ptl '((0 . "*line,arc,ellipse")))) ;;得到所有和这个曲线相交的曲线实体到选择集ss<br />     (setq ptl (xdrx_getinters e ss)) ;;得到曲线E和选择集中所有曲线的实际交点，不延伸。<br />     (setq p (cons e ptl)) ;;构造基于实体排序的函数xdrx_SortPointOnCurve的参数表<br />     (setq ptl (xdrx_sortpointoncurve e p)) ;;得到了排序后的点。<br /> <br />     这些功能若不用XDRX_API,只用LISP，要用几十倍的代码量才能完成。<br /> <br />     这些代码在求如建筑上轴网交点等等操作，极大的简化了代码量，速度还很快。<br /> <br />     可以求任意实体的交点和排序。<br />

XDRX_sortpointoncurve 的另外一个用法是用一个点表，不一定有实体 (xdrx_sortpointoncurve '(p1 p2) ptl)，还有sortpointoncurve后面有个可选的参数T，如果给, 省略重复的

eachy

介绍个实例，就是刚刚写的几个水利工具，截取其中的排序部分。

2. 
   
3. (while (setq e1 (xdrx_getentdata 0))
   
4.   (setq hi (read (car (xdrx_getxdata e1 "YB_high"))));读取线的高度信息
   
5.   (setq pint (xdrx_getinters e e1 0));等高线与剖线实体交点
   
6.   (if (= (length pint) 1);一个交点时
   
7.     (if        lst;构造点表 ((索引点 交点 高度) ... )
   
8.       (setq lst
   
9.              (append lst
   
10.                      (list (append (list (mapcar 'fix (car pint)));取整数点后面用来作索引
    
11.                                    pint;交点
    
12.                                    (list hi);高程
    
13.                            )
    
14.                      )
    
15.              )
    
16.       )
    
17.       (setq
    
18.         lst (list (append (list (mapcar 'fix (car pint)))
    
19.                           pint
    
20.                           (list hi)
    
21.                   )
    
22.             )
    
23.       )
    
24.     )
    
25.     (if        lst;两个交点情况
    
26.       (setq
    
27.         lst (append
    
28.               lst
    
29.               (list (list (mapcar 'fix (car pint))
    
30.                           (car pint)
    
31.                           hi
    
32.                     )
    
33.                     (list (mapcar 'fix (cadr pint))
    
34.                           (cadr pint)
    
35.                           hi
    
36.                     )
    
37.               )
    
38.             )
    
39.       )
    
40.       (setq lst
    
41.              (list
    
42.                (list (mapcar 'fix (car pint)) (car pint) hi)
    
43.                (list (mapcar 'fix (cadr pint))
    
44.                      (cadr pint)
    
45.                      hi
    
46.                )
    
47.              )
    
48.       )
    
49.     )
    
50.   )
    
51. )
    
52. ;;对上面的点表沿剖线排序，用整数点沿剖线排序
    
53. (setq
    
54.   lst1 (mapcar '(lambda (x) (mapcar 'fix x))
    
55.                (xdrx_sortpointoncurve e (mapcar 'cadr lst))
    
56.        )
    
57. )
    
58. ;;根据排序取出实际的交点表
    
59. (setq
    
60.   lst (mapcar 'cdr
    
61.               (mapcar '(lambda (x)
    
62.                          (assoc x lst)
    
63.                        )
    
64.                       lst1
    
65.               )
    
66.       )
    
67. )

<br /> (while (setq e1 (xdrx_getentdata 0))<br />   (setq hi (read (car (xdrx_getxdata e1 "YB_high"))));读取线的高度信息<br />   (setq pint (xdrx_getinters e e1 0));等高线与剖线实体交点<br />   (if (= (length pint) 1);一个交点时<br />     (if        lst;构造点表 ((索引点 交点 高度) ... )<br />       (setq lst<br />              (append lst<br />                      (list (append (list (mapcar 'fix (car pint)));取整数点后面用来作索引<br />                                    pint;交点<br />                                    (list hi);高程<br />                            )<br />                      )<br />              )<br />       )<br />       (setq<br />         lst (list (append (list (mapcar 'fix (car pint)))<br />                           pint<br />                           (list hi)<br />                   )<br />             )<br />       )<br />     )<br />     (if        lst;两个交点情况<br />       (setq<br />         lst (append<br />               lst<br />               (list (list (mapcar 'fix (car pint))<br />                           (car pint)<br />                           hi<br />                     )<br />                     (list (mapcar 'fix (cadr pint))<br />                           (cadr pint)<br />                           hi<br />                     )<br />               )<br />             )<br />       )<br />       (setq lst<br />              (list<br />                (list (mapcar 'fix (car pint)) (car pint) hi)<br />                (list (mapcar 'fix (cadr pint))<br />                      (cadr pint)<br />                      hi<br />                )<br />              )<br />       )<br />     )<br />   )<br /> )<br /> ;;对上面的点表沿剖线排序，用整数点沿剖线排序<br /> (setq<br />   lst1 (mapcar '(lambda (x) (mapcar 'fix x))<br />                (xdrx_sortpointoncurve e (mapcar 'cadr lst))<br />        )<br /> )<br /> ;;根据排序取出实际的交点表<br /> (setq<br />   lst (mapcar 'cdr<br />               (mapcar '(lambda (x)<br />                          (assoc x lst)<br />                        )<br />                       lst1<br />               )<br />       )<br /> )

eachy

再来一个实例，是写土方计算时用的，那时sortpointoncurve还没有

2. 
   
3.   ;;对点表按x升序y降序排序，按行形成新的点表
   
4.   (defun #sort_list (ptlist / ln mm pt_min l1 ll1 l2 ll l11)
   
5.     (setq l1         nil
   
6.           mm         (* 3e-4 (getvar "viewsize"))
   
7.           pt_min (getvar "extmin")
   
8.     )
   
9.     (foreach ll        (mapcar 'car ptlist)
   
10.       (setq ln (abs (xdrx_p2ldist ll pt_min (polar pt_min 0 1.0)))
    
11.             l2 l1
    
12.       )
    
13.       (while (and (setq ll1 (car l2))
    
14.                   (not (equal ln (car ll1) mm))
    
15.              )
    
16.         (setq l2 (cdr l2))
    
17.       )
    
18.       ;;将距离值近似的线段归入同一个子表内, 否则另开一个新的子表。
    
19.       (setq l1 (if ll1
    
20.                  (subst (append ll1 (list ll)) ll1 l1)
    
21.                  (cons (list ln ll) l1)
    
22.                )
    
23.       )
    
24.     )
    
25.     ;;y坐标降序
    
26.     (setq l11
    
27.            (mapcar 'cdr (reverse (apply 'xdrx_rlistsort2 l1)))
    
28.     )
    
29.     ;;ll x升序 ((x1 y) (x2 y) ... )      第一行网格交点坐标
    
30.     ;;          (x1' y1) (x2' y1) ...))  第二行网格交点坐标 .....
    
31.     (setq ll
    
32.            (mapcar '(lambda (x)
    
33.                       (vl-sort x
    
34.                                (function (lambda (e1 e2)
    
35.                                            (< (car e1) (car e2))
    
36.                                          )
    
37.                                )
    
38.                       )
    
39.                     )
    
40.                    l11
    
41.            )
    
42.     )
    
43.     ll
    
44.   )

<br />   ;;对点表按x升序y降序排序，按行形成新的点表 <br />   (defun #sort_list (ptlist / ln mm pt_min l1 ll1 l2 ll l11)<br />     (setq l1         nil<br />           mm         (* 3e-4 (getvar "viewsize"))<br />           pt_min (getvar "extmin")<br />     )<br />     (foreach ll        (mapcar 'car ptlist)<br />       (setq ln (abs (xdrx_p2ldist ll pt_min (polar pt_min 0 1.0)))<br />             l2 l1<br />       )<br />       (while (and (setq ll1 (car l2))<br />                   (not (equal ln (car ll1) mm))<br />              )<br />         (setq l2 (cdr l2))<br />       )<br />       ;;将距离值近似的线段归入同一个子表内, 否则另开一个新的子表。 <br />       (setq l1 (if ll1<br />                  (subst (append ll1 (list ll)) ll1 l1)<br />                  (cons (list ln ll) l1)<br />                )<br />       )<br />     )<br />     ;;y坐标降序 <br />     (setq l11<br />            (mapcar 'cdr (reverse (apply 'xdrx_rlistsort2 l1)))<br />     )<br />     ;;ll x升序 ((x1 y) (x2 y) ... )      第一行网格交点坐标 <br />     ;;          (x1' y1) (x2' y1) ...))  第二行网格交点坐标 ..... <br />     (setq ll<br />            (mapcar '(lambda (x)<br />                       (vl-sort x<br />                                (function (lambda (e1 e2)<br />                                            (< (car e1) (car e2))<br />                                          )<br />                                )<br />                       )<br />                     )<br />                    l11<br />            )<br />     )<br />     ll<br />   )

aeo

vl-sort本身是去掉重复项的

2. 
   
3. ;x排序
   
4. (vl-sort ptn '(lambda(x y)(< (car x)(car y))))
   
5. ;y排序
   
6. (vl-sort ptn '(lambda(x y)(< (cadr x)(cadr y))))
   

<br /> ;x排序<br /> (vl-sort ptn '(lambda(x y)(< (car x)(car y))))<br /> ;y排序<br /> (vl-sort ptn '(lambda(x y)(< (cadr x)(cadr y))))<br />

实在是点很近但不相同,想去掉就再处理一下.

lsjjm

5 楼:
vl-sort本身是不能去掉重复项的. 请看:(vl-sort '(2.0 1.3 2.4 1.3 3.4) '<)
返回: (1.3 1.3 2.0 2.4 3.4)

eachy

在帖一个，忘了作者了（QF？）

2. 
   
3. Sort_and_Write_pList :见附件
   
4. (defun Sort_and_Write_pList (fname plist / fp pt)
   
5.   ;; sort plist first
   
6.   (setq plist (vl-sort plist
   
7.        '(lambda (p1 p2)
   
8.   (cond ((< (car p1) (car p2)) T)
   
9. ((and (= (car p1) (car p2))
   
10.       (< (cadr p1) (cadr p2))
    
11. )
    
12. T
    
13. )
    
14. ((and (= (car p1) (car p2))
    
15.       (= (cadr p1) (cadr p2))
    
16.       (< (caddr p1) (caddr p2))
    
17. )
    
18. T
    
19. )
    
20. (T nil)
    
21.   )
    
22. )
    
23.       )
    
24.   )
    
25.   ;; write plist then
    
26.   (setq fp (open fname "w"))
    
27.   (foreach pt plist (princ pt fp) (princ "\n" fp))
    
28.   (close fp)
    
29. )
    
30. 
    
31. ;;;　测试上述函数
    
32. (Sort_and_Write_pList
    
33.   "c:/test.txt"
    
34.   '((1 3 4)
    
35.     (2 4 5)
    
36.     (3 4 5)
    
37.     (1 3 2)
    
38.     (3 5 2)
    
39.     (2 4 0)
    
40.     (1 2 3)
    
41.     (1 2 0)
    
42.     (1 1 0)
    
43.    )
    
44. )

<br /> Sort_and_Write_pList :见附件<br /> (defun Sort_and_Write_pList (fname plist / fp pt) <br />   ;; sort plist first <br />   (setq plist (vl-sort plist <br />        '(lambda (p1 p2) <br />   (cond ((< (car p1) (car p2)) T) <br /> ((and (= (car p1) (car p2)) <br />       (< (cadr p1) (cadr p2)) <br /> ) <br /> T <br /> ) <br /> ((and (= (car p1) (car p2)) <br />       (= (cadr p1) (cadr p2)) <br />       (< (caddr p1) (caddr p2)) <br /> ) <br /> T <br /> ) <br /> (T nil) <br />   ) <br /> ) <br />       ) <br />   ) <br />   ;; write plist then <br />   (setq fp (open fname "w")) <br />   (foreach pt plist (princ pt fp) (princ "\n" fp)) <br />   (close fp) <br /> ) <br /> <br /> ;;;　测试上述函数 <br /> (Sort_and_Write_pList <br />   "c:/test.txt" <br />   '((1 3 4) <br />     (2 4 5) <br />     (3 4 5) <br />     (1 3 2) <br />     (3 5 2) <br />     (2 4 0) <br />     (1 2 3) <br />     (1 2 0) <br />     (1 1 0) <br />    ) <br /> )

snsj

最初由 lsjjm 发布
[B]5 楼:
vl-sort本身是不能去掉重复项的. 请看:(vl-sort '(2.0 1.3 2.4 1.3 3.4) '<)
返回: (1.3 1.3 2.0 2.4 3.4) [/B]

VL-SORT只对整数有效,可以根据小数点的位数获取，还是用XDAPI划算些：）

2. 
   
3. (setq q '(2.0 1.3 2.4 1.3 3.4))
   
4. (setq a (mapcar
   
5.   '(lambda (x)
   
6.      (fix(* x 10))   
   
7.      )
   
8.      q
   
9.   ))
   
10. (setq b (vl-sort a '<))
    
11.      (mapcar
    
12.      '(lambda (y)
    
13.         (* y 0.1))
    
14.      b
    
15.      )
    

<br /> (setq q '(2.0 1.3 2.4 1.3 3.4))<br /> (setq a (mapcar<br />   '(lambda (x)<br />      (fix(* x 10))    <br />      )<br />      q<br />   ))<br /> (setq b (vl-sort a '<))<br />      (mapcar<br />      '(lambda (y)<br />         (* y 0.1))<br />      b<br />      )<br />

lsjjm

与8楼商权:
(Vl-sort  表 关系式)的基本定义为: 对<表>的内容安照<关系式>的要求进行重新排序, 返回新表.
我只是说5 楼的."vl-sort本身是去掉重复项的" 不完全.
同样, 8楼的 "VL-SORT只对整数有效" 显而易见, 也不完全,
另看: (vl-sort (list "D" "A" "B" "A" "C") '<) 返回: ("A" "A" "B" "C" "D") 仍不消重.
点的坐标绝大多数情况下部是整数吧?
其实, 对坐标点的排序正是利用了vl-sort 函数的不消重, 否则相同坐标的点, 会丢掉的!

aeo

vl-sort去掉重复项也只是可能,它的说明也这样说.
什么时候去掉了,只有autodesk才能说清楚:)
对坐标点排序,要判断两个实数相同,好象没个精确度不行.所以我说要再处理.
"对坐标点的排序正是利用了vl-sort 函数的不消重"正好符合了vl-sort的算法而已.它要给你去掉了,你也没办法,也只好将就.其实没vl-sort也排的很好.


(vl-sort  
   '(a d c b a)
   '(lambda (s1 s2)
     (< (vl-symbol-name s1) (vl-symbol-name s2)) ) )

(A B C D)又是只有一个a了

lsjjm

我看还是回到本贴的原问:"如何对坐标点排序？"这个出发点.
5楼和8 楼回答的完全与否, 大概不用费口舌了吧?

xyp1964

[php]
(setq ptlst (vl-sort ptlst (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))))
[/php]