[大家来试试]：将表的排序进行到底！全能的表排序函数！

fsxm

前面写的那个点排序只对点表
下面发的可对任何[B]"对应项可排序"[/B]的表.
没有太多用过不知道效果乍的？
请大家试用！看还有什么不足！敬请指教！多谢!

2. 
   
3. (defun sort-one        (getlist st / intlst astr bstr fun-lambda intlst lam
   
4.                  str-a str-b)
   
5.   (setq intlst (mapcar '1- (read (strcat "(" (substr st 2) ")"))))
   
6.   (setq str-a " a")
   
7.   (setq str-b " b")
   
8.   (if intlst
   
9.     (setq astr (foreach        tmp intlst
   
10.                  (setq str-a (strcat " (nth " (itoa tmp) str-a ")"))
    
11.                )
    
12.           bstr (foreach        tmp intlst
    
13.                  (setq str-b (strcat " (nth " (itoa tmp) str-b ")"))
    
14.                )
    
15.     )
    
16.   )
    
17.   (setq        lam (strcat "(FUNCTION (lambda (a b) ("
    
18.                     (substr st 1 1)
    
19.                     astr
    
20.                     bstr
    
21.                     ")))"
    
22.             )
    
23.   )
    
24.   (setq fun-lambda (cadr (eval (read lam))))
    
25.   (vl-sort getlist
    
26.            'fun-lambda
    
27.   )
    
28. )
    
29. (defun sortlist        (lst fun-lst)
    
30.   (foreach tmp (reverse fun-lst)
    
31.     (setq lst (sort-one lst tmp))
    
32.   )
    
33. )

<br /> (defun sort-one        (getlist st / intlst astr bstr fun-lambda intlst lam<br />                  str-a str-b)<br />   (setq intlst (mapcar '1- (read (strcat "(" (substr st 2) ")"))))<br />   (setq str-a " a")<br />   (setq str-b " b")<br />   (if intlst<br />     (setq astr (foreach        tmp intlst<br />                  (setq str-a (strcat " (nth " (itoa tmp) str-a ")"))<br />                )<br />           bstr (foreach        tmp intlst<br />                  (setq str-b (strcat " (nth " (itoa tmp) str-b ")"))<br />                )<br />     )<br />   )<br />   (setq        lam (strcat "(FUNCTION (lambda (a b) ("<br />                     (substr st 1 1)<br />                     astr<br />                     bstr<br />                     ")))"<br />             )<br />   )<br />   (setq fun-lambda (cadr (eval (read lam))))<br />   (vl-sort getlist<br />            'fun-lambda<br />   )<br /> )<br /> (defun sortlist        (lst fun-lst)<br />   (foreach tmp (reverse fun-lst)<br />     (setq lst (sort-one lst tmp))<br />   )<br /> )

2. 
   
3. ;;用法说明：
   
4. ;;顺次写出比较式"< or >"与比较量于list中
   
5. ;;多层次时用"/s"空格连接如:记下表为testlist
   
6. ;;'(
   
7. ;;  ("kaj" (4 ("c" 1)))
   
8. ;;  ("kbj" (6 ("a" 3)))
   
9. ;;  ("kcj" (5 ("b" 2)))
   
10. ;; )
    
11. ;;比较1，3，2时请用(sortlist testlist (list ">2 2 2"))
    
12. ;;比较c，a，b时请用(sortlist testlist (list ">2 2 1"))
    
13. ;;比较4，6，5时请用(sortlist testlist (list ">2 1"))
    
14. ;;比较kaj，kbj，kcj时请用(sortlist testlist (list ">1"))
    
15. ;;一起按级别比是用:(sortlist testlist (list ">2 2 2" ">2 2 1" ">2 1" ">1"))
    
16. 
    
17. 
    
18. ;;;测试如下:
    
19. (defun c:test ()
    
20.   (sortlist
    
21.     '(
    
22.       (1 (1 . 2) 3 ("kkj" 4) (3 0))
    
23.       (1 (1 . 4) 1 ("skj" 45) (2 3))
    
24.       (1 (1 . 2) 3 ("Aej" 45) (7 1))
    
25.       (1 (2 . 3) 2 ("ser" 4) (9 2))
    
26.       (2 (6 . 2) 2 ("Serj" 9) (1 4))
    
27.       (3 (3 . 5) 1 ("kkjsd" 35) (7 6))
    
28.       (2 (4 . 7) 2 ("Akjdd" 3) (5 4))
    
29.       (3 (3 . 3) 3 ("sekj" 446) (3 4))
    
30.       (2 (2 . 2) 2 ("serj" 9) (1 4))
    
31.       (1 (8 . 2) 2 ("wggj" 46) (2 4))
    
32.       (1 (1 . 4) 1 ("kkj" 9) (4 4))
    
33.       (3 (3 . 3) 3 ("sekj" 446) (3 4))
    
34.       (1 (8 . 2) 2 ("wggj" 46) (2 4))
    
35.      )
    
36.     (list
    
37.       ;;排序条件：
    
38.       ;;第一条件，依据数据("kkj" 4)中的'kkj'   =4项中第1
    
39.       ">4 1"
    
40.       ;;第二条件，依据数据'1'，即             =第1项
    
41.       ">1"
    
42.       ;;第三条件，依据数据(1 . 4)中的　1       =2项中第1
    
43.       ">2 1"
    
44.       ;;第四条件，依据数据(3 0)中的　0         =5项中第2
    
45.       ">5 2"
    
46.       ;;第五条件，依据数据("kkj" 4)中的　4     =4项中第2
    
47.       ">4 2"
    
48.       ;;排序的优先级为1、2、3、4、5
    
49. )
    
50.   )
    
51. )
    

<br /> ;;用法说明：<br /> ;;顺次写出比较式"< or >"与比较量于list中<br /> ;;多层次时用"/s"空格连接如:记下表为testlist<br /> ;;'(<br /> ;;  ("kaj" (4 ("c" 1)))<br /> ;;  ("kbj" (6 ("a" 3)))<br /> ;;  ("kcj" (5 ("b" 2)))<br /> ;; )<br /> ;;比较1，3，2时请用(sortlist testlist (list ">2 2 2"))<br /> ;;比较c，a，b时请用(sortlist testlist (list ">2 2 1"))<br /> ;;比较4，6，5时请用(sortlist testlist (list ">2 1"))<br /> ;;比较kaj，kbj，kcj时请用(sortlist testlist (list ">1"))<br /> ;;一起按级别比是用:(sortlist testlist (list ">2 2 2" ">2 2 1" ">2 1" ">1"))<br /> <br /> <br /> ;;;测试如下:<br /> (defun c:test ()<br />   (sortlist<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 />     (list<br />       ;;排序条件：<br />       ;;第一条件，依据数据("kkj" 4)中的'kkj'   =4项中第1<br />       ">4 1"<br />       ;;第二条件，依据数据'1'，即             =第1项<br />       ">1"<br />       ;;第三条件，依据数据(1 . 4)中的　1       =2项中第1<br />       ">2 1"<br />       ;;第四条件，依据数据(3 0)中的　0         =5项中第2<br />       ">5 2"<br />       ;;第五条件，依据数据("kkj" 4)中的　4     =4项中第2<br />       ">4 2"<br />       ;;排序的优先级为1、2、3、4、5<br /> )<br />   )<br /> )<br />

xiao_longxin

兄弟有思路和我大同小异，但兄弟的条件参数更通俗易懂

[PHP]
                                        ;表排序通用函数，By xiao_longxin

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

  (order coord tt)
)


;;;主程序
(defun order (coord_list tj / coord_ord        coord_I        i j k n        tj_ tj_c tj_1
              tj_2)

  (setq n (length coord_list))
  (setq k (length tj))
  (setq tj_ "(cond ((")

  (setq tj_1 (nth 0 (nth 0 tj)))
  (setq tj_2 tj_1)
  (setq tj_1 (strcat tj_1 " p1"))
  (setq tj_2 (strcat tj_2 " p2"))
  (repeat (nth 1 (nth 0 tj))
    (setq tj_1 (strcat tj_1 ")"))
    (setq tj_2 (strcat tj_2 ")"))
  )
  (setq tj_ (strcat tj_ (nth 2 (nth 0 tj)) " " tj_1 tj_2 ") t) "))

  (setq tj_c "((and ")
  (setq i 1)
  (repeat (- k 1)
    (setq tj_c (strcat tj_c "(= " tj_1 " " tj_2 ")"))

    (setq tj_1 (nth 0 (nth i tj)))
    (setq tj_2 tj_1)
    (setq tj_1 (strcat tj_1 " p1"))
    (setq tj_2 (strcat tj_2 " p2"))
    (repeat (nth 1 (nth i tj))
      (setq tj_1 (strcat tj_1 ")"))
      (setq tj_2 (strcat tj_2 ")"))
    )

    (setq tj_ (strcat tj_
                      tj_c
                      "("
                      (nth 2 (nth i tj))
                      " "
                      tj_1
                      tj_2
                      ")) t) "
              )
    )

    (setq i (1+ i))
  )
  (setq tj_ (strcat tj_ "(t nil))"))
  ;;'(cond
  ;;((< (car p1) (car p2)) T)
  ;;((and
  ;;(= (car p1) (car p2))
  ;;(< (cadr p1) (cadr p2))
  ;;)
  ;;T
  ;;)
  ;;((and
  ;;(= (car p1) (car p2))
  ;;(= (cadr p1) (cadr p2))
  ;;(< (caddr p1) (caddr p2))
  ;;)
  ;;T
  ;;)
  ;;(T nil)
  ;;)

  (setq
    coord_i
     (vl-sort-i        coord_list
                (function (lambda (p1 p2)
                            (eval (read tj_))
                          )
                )

     )
  )

  (setq j 0)
  (repeat n
    (setq
      coord_ord        (append        coord_ord
                        (list (nth (nth j coord_i) coord_list))
                )
    )
    (setq j (1+ j))
  )
  (setq coord_ord coord_ord)
)

[/PHP]

jx2008

很好，多谢楼长两位奉献！

shaobotao

师傅们做什么用处啊,我怎么使用后出现什么nil错误

GTJ116600

飞诗的表排序函数，要看看

qhdycm2016

这个函数就是神器呀