求大神指导，二维坐标排序问题
本帖最后由 张和平 于 2013-4-21 23:00 编辑我现在根据【自贡黄明儒】的函数自己稍作改编了一下，得到如下函数中二维坐标排序函数。现在问题来了，我用这个函数获得如下图形中指定点(A,B,C,D,E,F,G,H)的坐标，比如A点可以先获得这个多边形边界的各端点坐标表，然后先按Y从小到大排序后按X从小到大排序获得新点表，读取这个新点表的第一个元素便是A点坐标。
现在分两种情况描述：
1、我手动输入A~H点坐标，形成一个点表（即test1），然后排序，按上述方法能够准确获得各点坐标；
2、我用boundary命令获得边界pline并获得这个pline的各端点坐标形成点表，然后按上述方法，获得的有些点的坐标就不能正确获得了。
不知其中的原因为何。。。请大神们出手帮忙看看，，，
(defun c:test1()
(vl-load-com)
(defun *error* (msg)
(princ "\n**error: ")
(princ msg) ;_ 打印错误信息
(princ)
)
(setq plist '((4 3)(0 3)(1 4)(3 4)(0 1)(4 1)(3 0)(1 0)))
(setq p1 (car (test:Sort_pList plist "D->U" "L->R")))
(setq p2 (car (test:Sort_pList plist "L->R" "D->U")))
(setq p3 (car (test:Sort_pList plist "L->R" "U->D")))
(setq p4 (car (test:Sort_pList plist "U->D" "L->R")))
(setq p5 (car (test:Sort_pList plist "U->D" "R->L")))
(setq p6 (car (test:Sort_pList plist "R->L" "U->D")))
(setq p7 (car (test:Sort_pList plist "R->L" "D->U")))
(setq p8 (car (test:Sort_pList plist "D->U" "R->L")))
(PRINC P1)
(PRINC P2)
(PRINC P3)
(PRINC P4)
(PRINC P5)
(PRINC P6)
(PRINC P7)
(PRINC P8)
(PRINC)
)
(defun c:test2()
(setq P1 (getpoint "\n指定区域内部任意一点:"))
(command ".Boundary" p1 "")
(setq holeboundary (entlast))
(setq holepointslst (Assoc_ItemList 10 (entget holeboundary '("*")))) ;获取边界PLINE的端点列表
(setq holepointnum (length holepointslst))
(PRINC holepointslst)
(setq P1 (car (test:Sort_pList holepointslst "D->U" "L->R"))) ;左下角点1
(setq P2 (car (test:Sort_pList holepointslst "L->R" "D->U"))) ;左下角点2
(setq P3 (car (test:Sort_pList holepointslst "L->R" "U->D"))) ;左上角点1
(setq P4 (car (test:Sort_pList holepointslst "U->D" "L->R"))) ;左上角点2
(setq P5 (car (test:Sort_pList holepointslst "U->D" "R->L"))) ;右上角点1
(setq P6 (car (test:Sort_pList holepointslst "R->L" "U->D"))) ;右上角点2
(setq P7 (car (test:Sort_pList holepointslst "R->L" "D->U"))) ;右下角点1
(setq P8 (car (test:Sort_pList holepointslst "D->U" "R->L"))) ;右下角点2
(princ "\n")
(PRINC P1)
(PRINC P2)
(princ "\n")
(PRINC P3)
(PRINC P4)
(princ "\n")
(PRINC P5)
(PRINC P6)
(princ "\n")
(PRINC P7)
(PRINC P8)
(princ)
)
;;二维坐标排序
;;"D->U"从下到上;"U->D"从上到下;"L->R"从左到右;"R->L"从右到左
;;排序有先后，若调用如：(test:Sort_pList plist "D->U" "L->R")，
;;则整体按y从小到大排序，遇x值相同时，按x从小到大排序
(defun test:Sort_pList (PLIST Sort1 Sort2 / Symbol1 Symbol2 plistout)
(vl-load-com)
(cond
((member Sort1 (list "L->R" "R->L")) ;若sort1为"L->R"或"R->L"，则先x向排序后y向排序，反之亦然
(cond ((= Sort1 "L->R") (setq Symbol1 '<)) ;若sort1="L->R",则(eval Symbol1)=>
(T (setq Symbol1 '>)) ;否则Symbol1=<
)
(cond ((= Sort2 "D->U") (setq Symbol2 '<)) ;若sort2="D->U",则(eval Symbol2)=>
(T (setq Symbol2 '>)) ;否则Symbol2=<
)
(setq plistout
(vl-sort
PLIST
'(lambda (p1 p2)
(cond (((eval Symbol1) (car p1) (car p2)) T)
((and (= (car p1) (car p2))
((eval Symbol2) (cadr p1) (cadr p2))
)
T
)
)
)
)
)
)
(T
(cond ((= Sort1 "D->U") (setq Symbol1 '<))
(T (setq Symbol1 '>))
)
(cond ((= Sort2 "L->R") (setq Symbol2 '<))
(T (setq Symbol2 '>))
)
(setq plistout
(vl-sort
PLIST
'(lambda (p1 p2)
(cond (((eval Symbol1) (cadr p1) (cadr p2)) T)
((and (= (cadr p1) (cadr p2))
((eval Symbol2) (car p1) (car p2))
)
T
)
)
)
)
)
)
)
plistout
)=====自己的分析
请看TEST1的计算结果
命令: TEST1
(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的结果显示：
指定区域内部任意一点:((4.0 3.0) (3.0 3.0) (3.0 4.0) (1.0 4.0) (1.0 3.0) (0.0
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
1.0))
(3.0 1.49376e-016)(0.0 1.0) ;应该为A\B
(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 于 2013-4-22 20:44 编辑
1、补充个函数
(defun Assoc_ItemList (int ent / tmp lst)
(foreach tmp ent
(if (= (car tmp) int)
(setq lst (cons (cdr tmp) lst))
)
)
(reverse lst)
)
2、看你的返回结果，貌似是数字小数位上，有问题，
建议test:Sort_pList在vl-sort比较过程中不要用= ，而用equal，并置入允许误差，即可。
自己顶一下，， 我帮你一起顶！ zml84 发表于 2013-4-22 20:43 static/image/common/back.gif
1、补充个函数
2、看你的返回结果，貌似是数字小数位上，有问题，
你的方法很简洁，我等下试试看
以下是我自己的解决办法：
思路很简单，就是在坐标形成list时把坐标进行一下格式转换，，;把坐标值转换成一定小数位数的坐标 by PEACE 2013/04/22
(defun PEACE:DK_coordchange(point fractlen / x y)
(setq x (atof (rtos (car point) 2 fractlen)))
(setq y (atof (rtos (cadr point) 2 fractlen)))
(setq point (list x y))
point
)
;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回
(defun Assoc_ItemList (Item Alist / a lst point)
(while (setq a (assoc Item Alist))
(setqAlist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表
point (PEACE:DK_coordchange (cdr a) 10)
lst (cons point lst)
)
)
(reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序
) 后来想想，干脆把坐标值改成两位小数保留得了，附上转化成两位小数的函数：;;;把坐标值转换成一定小数位数的坐标 by PEACE 2013/04/22
;;;POINT=需要转换的点,FRACTLEN=小数位数，若小于0则自动赋予0，若为正实数，则自动转换成正整数
(defun PEACE:DK_coordchange(point fractlen / x y)
(if (< fractlen 0)
(setq fractlen 0)
)
(setq fractlen (fix fractlen))
(setq x (/ (fix (* (car point) (expt 10 fractlen))) (expt 10 fractlen)))
(setq y (/ (fix (* (cadr point) (expt 10 fractlen))) (expt 10 fractlen)))
;(setq x (atof (rtos (car point) 2 fractlen)))
;(setq y (atof (rtos (cadr point) 2 fractlen)))
(setq point (list x y))
point
)
;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回
(defun Assoc_ItemList (Item Alist / a lst point)
(while (setq a (assoc Item Alist))
(setqAlist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表
point (PEACE:DK_coordchange (cdr a) 2)
lst (cons point lst)
)
)
(reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序
) 可以考虑使用环形排序的方法
页:
[1]