圖上的圓編號,依圓心座標x軸y軸大小分為8種排序方式

f5612140

歡迎來找碴,

meflying

在你的基础上把排序部分改了一下:顺序可能跟你不一样,那个cond里你自己改一下你的取圆心部分怎么那么罗嗦?即使用ACTIVEX方法,也不需要那个pt_save啊

2. (defun c:111 (/ txth ss ans pt_list i ename ptms fun pt)
3.    (vl-load-com)
4.    (setvar "cmdecho" 0)
5.    (setvar "blipmode" 0)
6.    (setq txth (getvar "textsize"))
7.    (setq ss (ssget '((0 . "CIRCLE"))))
8.    (initget "1 2 3 4 5 6 7 8")
9.    (setq ans (getkword "\n輸入排序方向<1-8>:"))
10.    (setq pt_list '())
11.    (setq i 0)
12.    (repeat (sslength ss)
13.        (setq ename (ssname ss i))
14.        (setq ptms (cdr (assoc 10 (entget ename))))
15.        (setq pt_list (cons ptms pt_list))
16.        (setq i (+ i 1))
17.    )
18.    (cond
19.        ((= ans "1") (setq fun '(car cadr < <)))
20.        ((= ans "2") (setq fun '(car cadr > <)))
21.        ((= ans "3") (setq fun '(car cadr < >)))
22.        ((= ans "4") (setq fun '(car cadr > >)))
23.        ((= ans "5") (setq fun '(cadr car < <)))
24.        ((= ans "6") (setq fun '(cadr car > <)))
25.        ((= ans "7") (setq fun '(cadr car < >)))
26.        ((= ans "8") (setq fun '(cadr car > >)))
27.    )
28.    (setq pt_list (vl-sort pt_list
29.        '(lambda (e1 e2)
30.              ((eval (nth 2 fun))
31.                  ((eval (nth 0 fun)) e1)
32.                  ((eval (nth 0 fun)) e2)
33.              )
34.          )
35.    )
36.    )
37.    (setq pt_list (vl-sort pt_list
38.        '(lambda (e1 e2)
39.              ((eval (nth 3 fun))
40.                  ((eval (nth 1 fun)) e1)
41.                  ((eval (nth 1 fun)) e2)
42.              )
43.          )
44.    )
45.    )
46.    (setq i 0)
47.    (repeat (sslength ss)
48.        (setq pt (nth i pt_list))
49.        (command "text" "m" pt txth 0 (rtos (+ i 1)))
50.        (setq i (+ i 1))
51.    )
52.    (prin1)
53. )

(defun c:111 (/ txth ss ans pt_list i ename ptms fun pt)    (vl-load-com)    (setvar "cmdecho" 0)    (setvar "blipmode" 0)    (setq txth (getvar "textsize"))    (setq ss (ssget '((0 . "CIRCLE"))))    (initget "1 2 3 4 5 6 7 8")    (setq ans (getkword "\n輸入排序方向<1-8>:"))    (setq pt_list '())    (setq i 0)    (repeat (sslength ss)        (setq ename (ssname ss i))        (setq ptms (cdr (assoc 10 (entget ename))))        (setq pt_list (cons ptms pt_list))        (setq i (+ i 1))    )    (cond        ((= ans "1") (setq fun '(car cadr < <)))        ((= ans "2") (setq fun '(car cadr > <)))        ((= ans "3") (setq fun '(car cadr < >)))        ((= ans "4") (setq fun '(car cadr > >)))        ((= ans "5") (setq fun '(cadr car < <)))        ((= ans "6") (setq fun '(cadr car > <)))        ((= ans "7") (setq fun '(cadr car < >)))        ((= ans "8") (setq fun '(cadr car > >)))    )    (setq pt_list (vl-sort pt_list        '(lambda (e1 e2)              ((eval (nth 2 fun))                  ((eval (nth 0 fun)) e1)                  ((eval (nth 0 fun)) e2)              )          )    )    )    (setq pt_list (vl-sort pt_list        '(lambda (e1 e2)              ((eval (nth 3 fun))                  ((eval (nth 1 fun)) e1)                  ((eval (nth 1 fun)) e2)              )          )    )    )    (setq i 0)    (repeat (sslength ss)        (setq pt (nth i pt_list))        (command "text" "m" pt txth 0 (rtos (+ i 1)))        (setq i (+ i 1))    )    (prin1) )

f5612140

謝謝指正


另一個問題,如果將圖上的數個圓旋轉一個角度(如25度)再旋轉回來(-25度)重做一遍,排序結果會有異常

meflying

这是CAD内部精度问题,旋转后那些原来 X坐标相同的,现在其实不同了,会有一点点的不同,这个不同作为平常位置要求,完全可以忽略,但要作为比较用,就完全不同了,解决的办法就是你自己做一个大于和小于的函数代替 &gt; 和 &lt;,要求就是如果两个数差一点点都算等于,即如果A和B相差一个极小的数值(精度控制),使用你的大于和小于符号,都返回nil

f5612140

我原本提供的程序選1,3,5,7時會有異常,2,4,6,8則不會,之前研究老半天,心中也曾有老大您說的看法,可是查詢座標點則看不出所以然,也用過誤差控制,一樣無效,這程序本身是寫好玩的,在實際工作中並未用到,但透過這過程,多了解一些排序的觀念,THANKS



PS.請套用的人要自行注意這樣的問題

citykunan

飞哥编的程序真是很妙啊！

kevinchan

80万个圆做标注的时候我用了一天一夜才弄5万。程序还可以优化么？