将点的排序进行到底！功能全面的通用点表排序函数！更新:(加入容差功能)

fsxm

功能：对2d,3d点表排序.
用法：(sort-pt 点表 str)
如：(sort-pt plst "x")
说明:str可以 XYZxyz  6个字的任意组合.
大写为从大到小排列，小写为从小到大排列.
字符前后说明优先级别的大小，级别大的优先考虑。
(容差功能请见三楼的贴子.)

2. (defun sort-pt-1 (plts fun n)
   
3.   (vl-sort plts
   
4.            '(lambda (a b)
   
5.               (fun (nth n a) (nth n b))
   
6.             )
   
7.   )
   
8. )
   
9. (defun sort-pt (plst xyz / fun)
   
10.   (setq xyz (vl-string->list xyz))
    
11.   (foreach n-xyz (reverse xyz)
    
12.     (if        (< n-xyz 100)
    
13.       (setq fun          >
    
14.             n-xyz (- n-xyz 88)
    
15.             plst  (sort-pt-1 plst fun n-xyz)
    
16.       )
    
17.       (setq fun          <
    
18.             n-xyz (- n-xyz 120)
    
19.             plst  (sort-pt-1 plst fun n-xyz)
    
20.       )
    
21.     )
    
22.   )
    
23. )

(defun sort-pt-1 (plts fun n)<br />   (vl-sort plts<br />            '(lambda (a b)<br />               (fun (nth n a) (nth n b))<br />             )<br />   )<br /> )<br /> (defun sort-pt (plst xyz / fun)<br />   (setq xyz (vl-string->list xyz))<br />   (foreach n-xyz (reverse xyz)<br />     (if        (< n-xyz 100)<br />       (setq fun          ><br />             n-xyz (- n-xyz 88)<br />             plst  (sort-pt-1 plst fun n-xyz)<br />       )<br />       (setq fun          <<br />             n-xyz (- n-xyz 120)<br />             plst  (sort-pt-1 plst fun n-xyz)<br />       )<br />     )<br />   )<br /> )

测试：
命令: !plst
((10000 10000) (10000 201) (10000 200) (100 200) (1 -1) (1 0) (905.476 69.521)
(901.521 53.8912) (886.278 45.4492) (872.366 51.1843))
命令:
命令: (sort-pt plst "x")
((1 -1) (1 0) (100 200) (872.366 51.1843) (886.278 45.4492) (901.521 53.8912)
(905.476 69.521) (10000 10000) (10000 201) (10000 200))
命令:
命令: (sort-pt plst "X")
((10000 10000) (10000 201) (10000 200) (905.476 69.521) (901.521 53.8912)
(886.278 45.4492) (872.366 51.1843) (100 200) (1 -1) (1 0))
命令:
命令: (sort-pt plst "xy")
((1 -1) (1 0) (100 200) (872.366 51.1843) (886.278 45.4492) (901.521 53.8912)
(905.476 69.521) (10000 200) (10000 201) (10000 10000))
命令:
命令: (sort-pt plst "Xy")
((10000 200) (10000 201) (10000 10000) (905.476 69.521) (901.521 53.8912)
(886.278 45.4492) (872.366 51.1843) (100 200) (1 -1) (1 0))

命令: (sort-pt plst "y")
((1 -1) (1 0) (886.278 45.4492) (872.366 51.1843) (901.521 53.8912) (905.476
69.521) (10000 200) (100 200) (10000 201) (10000 10000))

qjcpj

支持，请继续发。

fsxm

有了老大们的支持我只好努力再努力了哦！！
在明经看到了加入误差的2D排序！受到启发！
将上面的sort-pt-1子程式改了一下：
[php](defun sort-pt-1 (plst fun n fuzz)
  (vl-sort plst
           '(lambda (a b)
              (if (not (equal (nth n a) (nth n b) fuzz))
                (fun (nth n a) (nth n b))
              )
            )
  )
)
(defun sort-pt (plst xyz fuzz / fun)
  (setq xyz (vl-string->list xyz))
  (foreach n-xyz (reverse xyz)
    (if        (< n-xyz 100)
      (setq fun          >
            n-xyz (- n-xyz 88)
      )
      (setq fun          <
            n-xyz (- n-xyz 120)
      )
    )
    (setq plst (sort-pt-1 plst fun n-xyz fuzz))
  )
)
[/php]
呵呵！又一个新的函数出来了！
用法：(sort-pt 点表 字符 误差)
点表：为2d or 3d 的点位置列表。
字符：为“xyzXYZ”6个字符的任意组合。
大写为从大到小排列，小写为从小到大排列。
字符前后说明优先级别的大小，级别大的优先考虑。
如x,y,z,X,Y,Z,xy,xyz,XyZ,zYx,Yx等等.
误差：为在误差允许值内认为相等。

明经原贴为：
NB_px 二维坐标表排序
对比:
(NB_px '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
       (list 0 < >)
       0
)
(sort-pt '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
         "xY"
         0
)
(sort-pt '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
         "x"
         0
)

对比:
(NB_px '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
       (list 0 > >)
       0
)
(sort-pt '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
         "XY"
         0
)
(sort-pt '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
         "X"
         0
)

对比:
(NB_px '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
       (list 1 < >)
       0
)
(sort-pt '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
         "Yx"
         0
)
(sort-pt '((6 4) (7 3) (6 2) (7 9) (2 2) (1 6))
         "Y"
         0
)

它山之石

最初由 fsxm 发布
[B]说明:str可以 XYZxyz  6个字的任意组合.
大写为从大到小排列，小写为从小到大排列.
字符前后说明优先级别的大小，级别大的优先考虑。... [/B]

这个创意好，简化了很多啊，亏你想的出。

xyz518mm

真是不错的排序函数
您真是厉害阿

xiao_longxin

阀值的想法不错，更有实际意义

请问楼主，如果要到任意表进行排序呢？
如：

;;         '(
;;           (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))
;;          )

排序条件：
;;第一条件，依据数据("kkj" 4)中的'kkj'
;;第二条件，依据数据'1'，即第一项
;;第三条件，依据数据(1 . 4)中的　1
;;第四条件，依据数据(3 0)中的　0
;;第五条件，依据数据("kkj" 4)中的　4
排序的优先级为1、2、3、4、5

即类似于在数据库中对各个字段进行按条件排序，而各个字段的数据类型是不一样的。每一个字段又可以是组合数据

knight928

1楼楼主，你的程序中排序如何判断其中重复的项存在？？？如：
命令: !plst
((10000 10000) (10000 201) (10000 201) (100 200) (1 -1) (1 0) (905.476 69.521)
(901.521 53.8912) (886.278 45.4492) (872.366 51.1843))
如何取出重复的项目？？

fsxm

1。请问楼主，如果要到任意表进行排序呢？
回复：现在想好了！见:对任意表进行排序
http://p4.xdcad.net/forum/showthread.php?s=&threadid=564276
2。1楼楼主，你的程序中排序如何判断其中重复的项存在？？？
回复：这个请在外部处理好了再传到本函数。(在本程序中就是有相同项也不会被删除!像平时一样的排序)
我这个只是对点表排序啦！可不是什么万能函数！

xyz518mm

请问一下若像这样排序函数该怎样加入"equal"误差判断呢?
(defun sub (pt_list)
(setq y_sort_list
(vl-sort pt_list '(lambda (1% 2%) (> (cadr 1%) (cadr 2%)))))
(setq all_sort_list
(vl-sort y_sort_list '(lambda (1% 2%) (< (car 1%) (car 2%)))))
)

fsxm

这与上面的是一个样的啊？将 (nth n X)改写成你要的(cadr X) ,(car X)  

1. 
   
2. '(lambda (a b)
   
3.    (if (not (equal (cadr a) (cadr b) fuzz))
   
4.      (> (cadr a) (cadr b))
   
5.    )
   
6. )
   
7. '(lambda (a b)
   
8.    (if (not (equal (car a) (car b) fuzz))
   
9.      (< (car a) (car b))
   
10.    )
    
11. )
    

复制代码

tctabc

请问 if 如果为另一结果时该怎样处里排序问题呢?
另外这部份的误差精度
该怎样决定呢?

'(lambda (a b)
   (if (not (equal (cadr a) (cadr b) fuzz))
     (> (cadr a) (cadr b))
   )
)
'(lambda (a b)
   (if (not (equal (cadr a) (cadr b) fuzz))
     (< (car a) (car b))
   )
)


是否可以帮忙解答一下

谢谢~

fsxm

如果IF成立了就按成立时给出的条件
去排列这两个比较元素没有给出条件就按在原表先后顺序排列！
如果IF不成立就按照不成立时给出的条件
去排列这两个比较元素没有给出条件就按在原表先后顺序排列！
我程序中只给出了IF成立时的排列条件：
(fun (nth n a) (nth n b))
没有给出IF不 成立时的排列条件则按在原表先后顺序排列！

多测试几次心里就有个结果了！

xyz518mm

谢谢您的说明~
那在Visual LISP中显示的座标值都只到小数1位,
那如果要排序到小数后的4位,
并显示出来,该怎样做呢?

fsxm

Visual LISP中显示的座标值都只到小数1位？？
为什么我在lisp中的都可以至少精确4个小数位呢？
精确位的问题不在本程序功能之内请预先在外部处理好再传到程序中处理为好！

tctabc

外部处理该怎样做呢?