求大神指导，二维坐标排序问题

张和平

我现在根据【自贡黄明儒】的函数自己稍作改编了一下，得到如下函数中二维坐标排序函数。现在问题来了，我用这个函数获得如下图形中指定点(A,B,C,D,E,F,G,H)的坐标，比如A点可以先获得这个多边形边界的各端点坐标表，然后先按Y从小到大排序后按X从小到大排序获得新点表，读取这个新点表的第一个元素便是A点坐标。
现在分两种情况描述：
1、我手动输入A~H点坐标，形成一个点表（即test1），然后排序，按上述方法能够准确获得各点坐标；
2、我用boundary命令获得边界pline并获得这个pline的各端点坐标形成点表，然后按上述方法，获得的有些点的坐标就不能正确获得了。
不知其中的原因为何。。。请大神们出手帮忙看看，，，

2. (defun c:test1()
   
3.   (vl-load-com)
   
4.   (defun *error* (msg)
   
5.     (princ "\n**error: ")
   
6.     (princ msg)      ;_ 打印错误信息
   
7.     (princ)         
   
8.   )
   
9.   (setq plist '((4 3)(0 3)(1 4)(3 4)(0 1)(4 1)(3 0)(1 0)))
   
10.   (setq p1 (car (test:Sort_pList plist "D->U" "L->R")))
    
11.   (setq p2 (car (test:Sort_pList plist "L->R" "D->U")))
    
12.   (setq p3 (car (test:Sort_pList plist "L->R" "U->D")))
    
13.   (setq p4 (car (test:Sort_pList plist "U->D" "L->R")))
    
14.   (setq p5 (car (test:Sort_pList plist "U->D" "R->L")))
    
15.   (setq p6 (car (test:Sort_pList plist "R->L" "U->D")))
    
16.   (setq p7 (car (test:Sort_pList plist "R->L" "D->U")))
    
17.   (setq p8 (car (test:Sort_pList plist "D->U" "R->L")))
    
18.   (PRINC P1)
    
19.   (PRINC P2)
    
20.   (PRINC P3)
    
21.   (PRINC P4)
    
22.   (PRINC P5)
    
23.   (PRINC P6)
    
24.   (PRINC P7)
    
25.   (PRINC P8)
    
26.   (PRINC)
    
27. )
    
28. (defun c:test2()
    
29.   (setq P1 (getpoint "\n指定区域内部任意一点:"))
    
30.   (command ".Boundary" p1 "")
    
31.   (setq holeboundary (entlast))
    
32.   (setq holepointslst (Assoc_ItemList 10 (entget holeboundary '("*")))) ;获取边界PLINE的端点列表
    
33.   (setq holepointnum (length holepointslst))
    
34.   (PRINC holepointslst)
    
35.   (setq P1 (car (test:Sort_pList holepointslst "D->U" "L->R"))) ;左下角点1
    
36.   (setq P2 (car (test:Sort_pList holepointslst "L->R" "D->U"))) ;左下角点2
    
37.   (setq P3 (car (test:Sort_pList holepointslst "L->R" "U->D"))) ;左上角点1
    
38.   (setq P4 (car (test:Sort_pList holepointslst "U->D" "L->R"))) ;左上角点2
    
39.   (setq P5 (car (test:Sort_pList holepointslst "U->D" "R->L"))) ;右上角点1
    
40.   (setq P6 (car (test:Sort_pList holepointslst "R->L" "U->D"))) ;右上角点2
    
41.   (setq P7 (car (test:Sort_pList holepointslst "R->L" "D->U"))) ;右下角点1
    
42.   (setq P8 (car (test:Sort_pList holepointslst "D->U" "R->L"))) ;右下角点2
    
43.   (princ "\n")
    
44.   (PRINC P1)  
    
45.   (PRINC P2)
    
46.   (princ "\n")
    
47.   (PRINC P3)
    
48.   (PRINC P4)
    
49.   (princ "\n")
    
50.   (PRINC P5)
    
51.   (PRINC P6)
    
52.   (princ "\n")
    
53.   (PRINC P7)
    
54.   (PRINC P8)
    
55.   (princ)
    
56. )
    
57. 
    
58. ;;二维坐标排序
    
59. ;;"D->U"从下到上;"U->D"从上到下;"L->R"从左到右;"R->L"从右到左
    
60. ;;排序有先后，若调用如：(test:Sort_pList plist "D->U" "L->R")，
    
61. ;;则整体按y从小到大排序，遇x值相同时，按x从小到大排序
    
62. (defun test:Sort_pList (PLIST Sort1 Sort2 / Symbol1 Symbol2 plistout)
    
63.   (vl-load-com)
    
64.   (cond
    
65.     ((member Sort1 (list "L->R" "R->L")) ;若sort1为"L->R"或"R->L"，则先x向排序后y向排序，反之亦然
    
66.       (cond ((= Sort1 "L->R") (setq Symbol1 '<)) ;若sort1="L->R",则(eval Symbol1)=>
    
67.             (T (setq Symbol1 '>))                    ;否则Symbol1=<
    
68.       )
    
69.       (cond ((= Sort2 "D->U") (setq Symbol2 '<)) ;若sort2="D->U",则(eval Symbol2)=>
    
70.             (T (setq Symbol2 '>))                    ;否则Symbol2=<
    
71.       )
    
72.       (setq plistout
    
73.       (vl-sort
    
74.         PLIST
    
75.        '(lambda (p1 p2)
    
76.           (cond (((eval Symbol1) (car p1) (car p2)) T)
    
77.                 ((and (= (car p1) (car p2))
    
78.                       ((eval Symbol2) (cadr p1) (cadr p2))
    
79.                  )
    
80.                  T
    
81.                 )
    
82.           )
    
83.         )
    
84.       )
    
85.       )
    
86.     )
    
87.     (T
    
88.       (cond ((= Sort1 "D->U") (setq Symbol1 '<))
    
89.             (T (setq Symbol1 '>))
    
90.       )
    
91.       (cond ((= Sort2 "L->R") (setq Symbol2 '<))
    
92.             (T (setq Symbol2 '>))
    
93.       )
    
94.       (setq plistout
    
95.       (vl-sort
    
96.         PLIST
    
97.        '(lambda (p1 p2)
    
98.           (cond (((eval Symbol1) (cadr p1) (cadr p2)) T)
    
99.                 ((and (= (cadr p1) (cadr p2))
    
100.                       ((eval Symbol2) (car p1) (car p2))
     
101.                  )
     
102.                  T
     
103.                 )
     
104.           )
     
105.         )
     
106.       )
     
107.       )
     
108.     )
     
109.   )
     
110.   plistout
     
111. )

(defun c:test1()<br />   (vl-load-com)<br />   (defun *error* (msg)<br />     (princ "\n**error: ")<br />     (princ msg)      ;_ 打印错误信息<br />     (princ)         <br />   )<br />   (setq plist '((4 3)(0 3)(1 4)(3 4)(0 1)(4 1)(3 0)(1 0)))<br />   (setq p1 (car (test:Sort_pList plist "D->U" "L->R")))<br />   (setq p2 (car (test:Sort_pList plist "L->R" "D->U")))<br />   (setq p3 (car (test:Sort_pList plist "L->R" "U->D")))<br />   (setq p4 (car (test:Sort_pList plist "U->D" "L->R")))<br />   (setq p5 (car (test:Sort_pList plist "U->D" "R->L")))<br />   (setq p6 (car (test:Sort_pList plist "R->L" "U->D")))<br />   (setq p7 (car (test:Sort_pList plist "R->L" "D->U")))<br />   (setq p8 (car (test:Sort_pList plist "D->U" "R->L")))<br />   (PRINC P1)<br />   (PRINC P2)<br />   (PRINC P3)<br />   (PRINC P4)<br />   (PRINC P5)<br />   (PRINC P6)<br />   (PRINC P7)<br />   (PRINC P8)<br />   (PRINC)<br /> )<br /> (defun c:test2()<br />   (setq P1 (getpoint "\n指定区域内部任意一点:"))<br />   (command ".Boundary" p1 "")<br />   (setq holeboundary (entlast))<br />   (setq holepointslst (Assoc_ItemList 10 (entget holeboundary '("*")))) ;获取边界PLINE的端点列表<br />   (setq holepointnum (length holepointslst))<br />   (PRINC holepointslst)<br />   (setq P1 (car (test:Sort_pList holepointslst "D->U" "L->R"))) ;左下角点1<br />   (setq P2 (car (test:Sort_pList holepointslst "L->R" "D->U"))) ;左下角点2<br />   (setq P3 (car (test:Sort_pList holepointslst "L->R" "U->D"))) ;左上角点1<br />   (setq P4 (car (test:Sort_pList holepointslst "U->D" "L->R"))) ;左上角点2<br />   (setq P5 (car (test:Sort_pList holepointslst "U->D" "R->L"))) ;右上角点1<br />   (setq P6 (car (test:Sort_pList holepointslst "R->L" "U->D"))) ;右上角点2<br />   (setq P7 (car (test:Sort_pList holepointslst "R->L" "D->U"))) ;右下角点1<br />   (setq P8 (car (test:Sort_pList holepointslst "D->U" "R->L"))) ;右下角点2<br />   (princ "\n")<br />   (PRINC P1)  <br />   (PRINC P2)<br />   (princ "\n")<br />   (PRINC P3)<br />   (PRINC P4)<br />   (princ "\n")<br />   (PRINC P5)<br />   (PRINC P6)<br />   (princ "\n")<br />   (PRINC P7)<br />   (PRINC P8)<br />   (princ)<br /> )<br /> <br /> ;;二维坐标排序<br /> ;;"D->U"从下到上;"U->D"从上到下;"L->R"从左到右;"R->L"从右到左<br /> ;;排序有先后，若调用如：(test:Sort_pList plist "D->U" "L->R")，<br /> ;;则整体按y从小到大排序，遇x值相同时，按x从小到大排序<br /> (defun test:Sort_pList (PLIST Sort1 Sort2 / Symbol1 Symbol2 plistout)<br />   (vl-load-com)<br />   (cond<br />     ((member Sort1 (list "L->R" "R->L")) ;若sort1为"L->R"或"R->L"，则先x向排序后y向排序，反之亦然<br />       (cond ((= Sort1 "L->R") (setq Symbol1 '<)) ;若sort1="L->R",则(eval Symbol1)=><br />             (T (setq Symbol1 '>))                    ;否则Symbol1=<<br />       )<br />       (cond ((= Sort2 "D->U") (setq Symbol2 '<)) ;若sort2="D->U",则(eval Symbol2)=><br />             (T (setq Symbol2 '>))                    ;否则Symbol2=<<br />       )<br />       (setq plistout<br />       (vl-sort<br />         PLIST<br />        '(lambda (p1 p2)<br />           (cond (((eval Symbol1) (car p1) (car p2)) T)<br />                 ((and (= (car p1) (car p2))<br />                       ((eval Symbol2) (cadr p1) (cadr p2))<br />                  )<br />                  T<br />                 )<br />           )<br />         )<br />       )<br />       )<br />     )<br />     (T<br />       (cond ((= Sort1 "D->U") (setq Symbol1 '<))<br />             (T (setq Symbol1 '>))<br />       )<br />       (cond ((= Sort2 "L->R") (setq Symbol2 '<))<br />             (T (setq Symbol2 '>))<br />       )<br />       (setq plistout<br />       (vl-sort<br />         PLIST<br />        '(lambda (p1 p2)<br />           (cond (((eval Symbol1) (cadr p1) (cadr p2)) T)<br />                 ((and (= (cadr p1) (cadr p2))<br />                       ((eval Symbol2) (car p1) (car p2))<br />                  )<br />                  T<br />                 )<br />           )<br />         )<br />       )<br />       )<br />     )<br />   )<br />   plistout<br /> )

=====自己的分析

请看TEST1的计算结果

1. 命令: TEST1
   
2. (1 0)(0 1)(0 3)(1 4)(3 4)(4 3)(4 1)(3 0) ;依次为A\B\C\D\E\F\G\H

复制代码

请看TEST2的结果显示：

1. 指定区域内部任意一点:((4.0 3.0) (3.0 3.0) (3.0 4.0) (1.0 4.0) (1.0 3.0) (0.0
   
2. 3.0) (0.0 1.0) (1.0 1.0) (1.0 2.71837e-016) (3.0 1.49376e-016) (3.0 1.0) (4.0
   
3. 1.0))
   
4. (3.0 1.49376e-016)(0.0 1.0) ;应该为A\B
   
5. (0.0 3.0)(1.0 4.0) ;应该为C\D

复制代码

自动获取的点坐标中，和test1的计算结果对比，发现获取的A点坐标是错误的。A\H点的坐标实际上应当为A=(1.0 2.71837e-016)，H=(3.0 1.49376e-016)，但是YA>YH，按照上述描述的获取A点坐标的方法（先按Y从小到大排序再按X从小到大排序），获取的A点坐标确实为(3.0 1.49376e-016)，因此，出现本文问题的原因便是CAD在处理数据上的容差问题，原本YA=YH=0，但是CAD分别赋予了2.71837e-016和1.49376e-016。
那么，避免这样问题的方法是什么呢？能不能设置一个容差呢？两者差小于这个容差时，便认为两者相等。

zml84

1、补充个函数

1. (defun Assoc_ItemList (int ent / tmp lst)
   
2.   (foreach tmp ent
   
3.     (if        (= (car tmp) int)
   
4.       (setq lst (cons (cdr tmp) lst))
   
5.     )
   
6.   )
   
7.   (reverse lst)
   
8. )

(defun Assoc_ItemList (int ent / tmp lst)<br />   (foreach tmp ent<br />     (if        (= (car tmp) int)<br />       (setq lst (cons (cdr tmp) lst))<br />     )<br />   )<br />   (reverse lst)<br /> )

2、看你的返回结果，貌似是数字小数位上，有问题，
建议test:Sort_pList在vl-sort比较过程中不要用= ，而用equal，并置入允许误差，即可。

张和平

自己顶一下，，

vlisp2012

我帮你一起顶！

张和平

zml84 发表于 2013-4-22 20:43
1、补充个函数

2、看你的返回结果，貌似是数字小数位上，有问题，

你的方法很简洁，我等下试试看
以下是我自己的解决办法：
思路很简单，就是在坐标形成list时把坐标进行一下格式转换，，

2. ;把坐标值转换成一定小数位数的坐标 by PEACE 2013/04/22
   
3. (defun PEACE:DK_coordchange(point fractlen / x y)
   
4.   (setq x (atof (rtos (car point) 2 fractlen)))
   
5.   (setq y (atof (rtos (cadr point) 2 fractlen)))
   
6.   (setq point (list x y))
   
7.   point
   
8. )
   
9. ;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回
   
10. (defun Assoc_ItemList (Item Alist / a lst point)
    
11.   (while (setq a (assoc Item Alist))
    
12.     (setq  Alist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表
    
13.            point (PEACE:DK_coordchange (cdr a) 10)
    
14.              lst (cons point lst)
    
15.     )
    
16.   )
    
17.   (reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序
    
18. )

;把坐标值转换成一定小数位数的坐标 by PEACE 2013/04/22<br /> (defun PEACE:DK_coordchange(point fractlen / x y)<br />   (setq x (atof (rtos (car point) 2 fractlen)))<br />   (setq y (atof (rtos (cadr point) 2 fractlen)))<br />   (setq point (list x y))<br />   point<br /> )<br /> ;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回<br /> (defun Assoc_ItemList (Item Alist / a lst point)<br />   (while (setq a (assoc Item Alist))<br />     (setq  Alist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表<br />            point (PEACE:DK_coordchange (cdr a) 10)<br />              lst (cons point lst)<br />     )<br />   )<br />   (reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序<br /> )

张和平

后来想想，干脆把坐标值改成两位小数保留得了，附上转化成两位小数的函数：

2. ;;;把坐标值转换成一定小数位数的坐标 by PEACE 2013/04/22
   
3. ;;;POINT=需要转换的点,FRACTLEN=小数位数，若小于0则自动赋予0，若为正实数，则自动转换成正整数
   
4. (defun PEACE:DK_coordchange(point fractlen / x y)
   
5.   (if (< fractlen 0)
   
6.     (setq fractlen 0)
   
7.   )
   
8.   (setq fractlen (fix fractlen))
   
9.   (setq x (/ (fix (* (car point) (expt 10 fractlen))) (expt 10 fractlen)))
   
10.   (setq y (/ (fix (* (cadr point) (expt 10 fractlen))) (expt 10 fractlen)))
    
11.   ;(setq x (atof (rtos (car point) 2 fractlen)))
    
12.   ;(setq y (atof (rtos (cadr point) 2 fractlen)))
    
13.   (setq point (list x y))
    
14.   point
    
15. )
    
16. ;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回
    
17. (defun Assoc_ItemList (Item Alist / a lst point)
    
18.   (while (setq a (assoc Item Alist))
    
19.     (setq  Alist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表
    
20.            point (PEACE:DK_coordchange (cdr a) 2)
    
21.              lst (cons point lst)
    
22.     )
    
23.   )
    
24.   (reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序
    
25. )

;;;把坐标值转换成一定小数位数的坐标 by PEACE 2013/04/22<br /> ;;;POINT=需要转换的点,FRACTLEN=小数位数，若小于0则自动赋予0，若为正实数，则自动转换成正整数<br /> (defun PEACE:DK_coordchange(point fractlen / x y)<br />   (if (< fractlen 0)<br />     (setq fractlen 0)<br />   )<br />   (setq fractlen (fix fractlen))<br />   (setq x (/ (fix (* (car point) (expt 10 fractlen))) (expt 10 fractlen)))<br />   (setq y (/ (fix (* (cadr point) (expt 10 fractlen))) (expt 10 fractlen)))<br />   ;(setq x (atof (rtos (car point) 2 fractlen)))<br />   ;(setq y (atof (rtos (cadr point) 2 fractlen)))<br />   (setq point (list x y))<br />   point<br /> )<br /> ;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回<br /> (defun Assoc_ItemList (Item Alist / a lst point)<br />   (while (setq a (assoc Item Alist))<br />     (setq  Alist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表<br />            point (PEACE:DK_coordchange (cdr a) 2)<br />              lst (cons point lst)<br />     )<br />   )<br />   (reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序<br /> )

skg123

可以考虑使用环形排序的方法