[原创]：真正的万能通用排序函数，对任何类型的表都有效

xiao_longxin

2. 
   
3. ;;测试程序
   
4. (defun c:test (/ coord tt)
   
5.   (setq        coord
   
6.          '(
   
7.            (1 (1 . 2) 3 ("kkj" 4) (3 0))
   
8.            (1 (1 . 4) 1 ("skj" 45) (2 3))
   
9.            (1 (1 . 2) 3 ("Aej" 45) (7 1))
   
10.            (1 (2 . 3) 2 ("ser" 4) (9 2))
    
11.            (2 (6 . 2) 2 ("Serj" 9) (1 4))
    
12.            (3 (3 . 5) 1 ("kkjsd" 35) (7 6))
    
13.            (2 (4 . 7) 2 ("Akjdd" 3) (5 4))
    
14.            (3 (3 . 3) 3 ("sekj" 446) (3 4))
    
15.            (2 (2 . 2) 2 ("serj" 9) (1 4))
    
16.            (1 (8 . 2) 2 ("wggj" 46) (2 4))
    
17.            (1 (1 . 4) 1 ("kkj" 9) (4 4))
    
18.            (3 (3 . 3) 3 ("sekj" 446) (3 4))
    
19.            (1 (8 . 2) 2 ("wggj" 46) (2 4))
    
20.           )
    
21.   )
    
22.   
    
23. ;;表第一项为要排序的依据，注意后面的括号没有，第二项即为后括号的个数，第三项为按升还是降排序
    
24.   (setq        tt '(("(nth 0 (nth 3 " 2 ">")
    
25.              ("(nth 0" 1 "<")
    
26.              ("(car (nth 1 " 2 "<")
    
27.              ("(nth 1 (nth 4 " 2 ">")
    
28.              ("(nth 1 (nth 3" 2 ">")
    
29.             )
    
30.   )
    
31. 
    
32.   (order coord tt)
    
33. )
    

<br /> ;;测试程序<br /> (defun c:test (/ coord tt)<br />   (setq        coord<br />          '(<br />            (1 (1 . 2) 3 ("kkj" 4) (3 0))<br />            (1 (1 . 4) 1 ("skj" 45) (2 3))<br />            (1 (1 . 2) 3 ("Aej" 45) (7 1))<br />            (1 (2 . 3) 2 ("ser" 4) (9 2))<br />            (2 (6 . 2) 2 ("Serj" 9) (1 4))<br />            (3 (3 . 5) 1 ("kkjsd" 35) (7 6))<br />            (2 (4 . 7) 2 ("Akjdd" 3) (5 4))<br />            (3 (3 . 3) 3 ("sekj" 446) (3 4))<br />            (2 (2 . 2) 2 ("serj" 9) (1 4))<br />            (1 (8 . 2) 2 ("wggj" 46) (2 4))<br />            (1 (1 . 4) 1 ("kkj" 9) (4 4))<br />            (3 (3 . 3) 3 ("sekj" 446) (3 4))<br />            (1 (8 . 2) 2 ("wggj" 46) (2 4))<br />           )<br />   )<br />   <br /> ;;表第一项为要排序的依据，注意后面的括号没有，第二项即为后括号的个数，第三项为按升还是降排序<br />   (setq        tt '(("(nth 0 (nth 3 " 2 ">")<br />              ("(nth 0" 1 "<")<br />              ("(car (nth 1 " 2 "<")<br />              ("(nth 1 (nth 4 " 2 ">")<br />              ("(nth 1 (nth 3" 2 ">")<br />             )<br />   )<br /> <br />   (order coord tt)<br /> )<br />

2. 
   
3. ;;;主程序
   
4. (defun order (coord_list tj / coord_ord        coord_I        i j k n        tj_ tj_c tj_1
   
5.               tj_2)
   
6. 
   
7.   (setq n (length coord_list))
   
8.   (setq k (length tj))
   
9.   (setq tj_ "(cond ((")
   
10. 
    
11.   (setq tj_1 (nth 0 (nth 0 tj)))
    
12.   (setq tj_2 tj_1)
    
13.   (setq tj_1 (strcat tj_1 " p1"))
    
14.   (setq tj_2 (strcat tj_2 " p2"))
    
15.   (repeat (nth 1 (nth 0 tj))
    
16.     (setq tj_1 (strcat tj_1 ")"))
    
17.     (setq tj_2 (strcat tj_2 ")"))
    
18.   )
    
19.   (setq tj_ (strcat tj_ (nth 2 (nth 0 tj)) " " tj_1 tj_2 ") t) "))
    
20. 
    
21.   (setq tj_c "((and ")
    
22.   (setq i 1)
    
23.   (repeat (- k 1)
    
24.     (setq tj_c (strcat tj_c "(= " tj_1 " " tj_2 ")"))
    
25. 
    
26.     (setq tj_1 (nth 0 (nth i tj)))
    
27.     (setq tj_2 tj_1)
    
28.     (setq tj_1 (strcat tj_1 " p1"))
    
29.     (setq tj_2 (strcat tj_2 " p2"))
    
30.     (repeat (nth 1 (nth i tj))
    
31.       (setq tj_1 (strcat tj_1 ")"))
    
32.       (setq tj_2 (strcat tj_2 ")"))
    
33.     )
    
34. 
    
35.     (setq tj_ (strcat tj_
    
36.                       tj_c
    
37.                       "("
    
38.                       (nth 2 (nth i tj))
    
39.                       " "
    
40.                       tj_1
    
41.                       tj_2
    
42.                       ")) t) "
    
43.               )
    
44.     )
    
45. 
    
46.     (setq i (1+ i))
    
47.   )
    
48.    (setq tj_ (strcat tj_ "(t nil))"))
    
49.   (setq
    
50.     coord_i
    
51.      (vl-sort-i        coord_list
    
52.                 (function (lambda (p1 p2)
    
53.                             (eval (read tj_))
    
54.                           )
    
55.                 )
    
56. 
    
57.      )
    
58.   )
    
59. 
    
60.   (setq j 0)
    
61.   (repeat n
    
62.     (setq
    
63.       coord_ord        (append        coord_ord
    
64.                         (list (nth (nth j coord_i) coord_list))
    
65.                 )
    
66.     )
    
67.     (setq j (1+ j))
    
68.   )
    
69.   (setq coord_ord coord_ord)
    
70. )
    

<br /> ;;;主程序<br /> (defun order (coord_list tj / coord_ord        coord_I        i j k n        tj_ tj_c tj_1<br />               tj_2)<br /> <br />   (setq n (length coord_list))<br />   (setq k (length tj))<br />   (setq tj_ "(cond ((")<br /> <br />   (setq tj_1 (nth 0 (nth 0 tj)))<br />   (setq tj_2 tj_1)<br />   (setq tj_1 (strcat tj_1 " p1"))<br />   (setq tj_2 (strcat tj_2 " p2"))<br />   (repeat (nth 1 (nth 0 tj))<br />     (setq tj_1 (strcat tj_1 ")"))<br />     (setq tj_2 (strcat tj_2 ")"))<br />   )<br />   (setq tj_ (strcat tj_ (nth 2 (nth 0 tj)) " " tj_1 tj_2 ") t) "))<br /> <br />   (setq tj_c "((and ")<br />   (setq i 1)<br />   (repeat (- k 1)<br />     (setq tj_c (strcat tj_c "(= " tj_1 " " tj_2 ")"))<br /> <br />     (setq tj_1 (nth 0 (nth i tj)))<br />     (setq tj_2 tj_1)<br />     (setq tj_1 (strcat tj_1 " p1"))<br />     (setq tj_2 (strcat tj_2 " p2"))<br />     (repeat (nth 1 (nth i tj))<br />       (setq tj_1 (strcat tj_1 ")"))<br />       (setq tj_2 (strcat tj_2 ")"))<br />     )<br /> <br />     (setq tj_ (strcat tj_<br />                       tj_c<br />                       "("<br />                       (nth 2 (nth i tj))<br />                       " "<br />                       tj_1<br />                       tj_2<br />                       ")) t) "<br />               )<br />     )<br /> <br />     (setq i (1+ i))<br />   )<br />    (setq tj_ (strcat tj_ "(t nil))"))<br />   (setq<br />     coord_i<br />      (vl-sort-i        coord_list<br />                 (function (lambda (p1 p2)<br />                             (eval (read tj_))<br />                           )<br />                 )<br /> <br />      )<br />   )<br /> <br />   (setq j 0)<br />   (repeat n<br />     (setq<br />       coord_ord        (append        coord_ord<br />                         (list (nth (nth j coord_i) coord_list))<br />                 )<br />     )<br />     (setq j (1+ j))<br />   )<br />   (setq coord_ord coord_ord)<br /> )<br />