[原创]：通用实体排序函数(更新)

eachy · 发表于 2005-1-13 18:09:27

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

遗憾，参与者寥寥，这时最后一次更新了(不在提供 fas ，里面包含 vlx 文件)。

;|
调用格式: (ea:sort_entity entity_list mode key vx)
参数说明:
1 mode 0 按行 1 按列
2 key
(mod = 0) (mod = 1)
1 Y降X升 X升Y降 (左上至右下)
2 Y降X降 X降Y降 (右上至左下)
3 Y升X降 X降Y升 (右下至左上)
4 Y升X升 X升Y升 (左下至右上)
3 vx 行(列)允许误差，为 nil 实取 0
4 entity_list 表, 格式如下
((pt1 ent1) (pt2 ent2) ... (ptn entn))
a pt 为 ent 的特征点， ent 可以为 entity 或 vla-object
比如对文字排序，pt 可以使用文字的插入点
b 当 pt 为实数时，vx 为行列最大及最小值的差值，此时 mode key 为任意值
如一组数 (1 3 56 89 56 45 6 8 45 91 45 69 78 15 12 11) vx 取 10
排序后为 ((1 3 6 8 11) (12 15) (45 45 45) (56 56) (69 78) (89 91))
总表及子表均为由大到小排列
返回值: 表，子表为按要求排列的行/列
说明: 因为是 lisp 函数，本函数内部并不对数据的合法性进行检查，以提高程序的效率
使用前确保各参数的的正确性
|;
;;********************************************************
;;示例一：将文字按要求排序号
;;使用前确保已经加载 sortobj.fas
;;压缩包内含 sortobj.fas 及 test.dwg (2k DWG)
;;********************************************************
(defun c:t1 (/ ss ssl e elst el n k1 k2 d pre sub)
(if (and (setq ss (ssget '((0 . "text"))))
(progn
(initget "0 1")
(setq k1 (getkword "\n[0 -按行/1 -按列]:"))
)
(progn
(initget "1 2 3 4")
(setq k2
(getkword
"\n[1-左上至右下/2-右上至左下/3-右下至左上/4-左下至右上]:"
)
)
)
(setq d (getdist "\n输入允许误差: "))
)
(progn
(setq ssl (sslength ss))
(while (> ssl 0)
(setq e (ssname ss (setq ssl (1- ssl))))
(setq elst (cons (list (cdr (assoc 10 (entget e))) e) elst))
)
(setq pre "K+" ;_ 前缀
;;sub "A" ;_ 后缀
)
(setq el (mapcar '(lambda (x) (mapcar 'cadr x))
(ea:sort_entity elst (atoi k1) (atoi k2) d)
)
)
(setq n 1) ;_ 起始值,
(mapcar
'(lambda (x)
(mapcar
'(lambda (e1)
(setq el (entget e1))
(entmod (subst (cons 1
(strcat pre;_ 前缀
(if (< n 10)
(strcat "0" (itoa n))
(itoa n)
);_ 可以进行格式化
;; sub;_ 后缀
)
)
(assoc 1 el)
el
)
)
(setq n (1+ n)) ;_ 可以定义步距
)
x
)
)
el
)
)
)
(princ)
)
;;示例二：对块中某一属性排序号(可以推广到对多个属性分别排序号)

;| 
调用格式: (ea:sort_entity entity_list mode key vx) 
参数说明: 
        1 mode 0 按行 1 按列 
        2 key 
             (mod = 0)    (mod = 1) 
          1  Y降X升       X升Y降   (左上至右下) 
          2  Y降X降       X降Y降   (右上至左下) 
          3  Y升X降       X降Y升   (右下至左上) 
          4  Y升X升       X升Y升   (左下至右上) 
        3 vx 行(列)允许误差，为 nil 实取 0 
        4 entity_list 表, 格式如下 
          ((pt1 ent1) (pt2 ent2) ... (ptn entn)) 
          a pt 为 ent 的特征点， ent 可以为 entity 或 vla-object 
            比如对文字排序，pt 可以使用文字的插入点 
             
          b 当 pt 为实数时，vx 为行列最大及最小值的差值，此时 mode key 为任意值 
            如一组数 (1 3 56 89 56 45 6 8 45 91 45 69 78 15 12 11) vx 取 10 
            排序后为 ((1 3 6 8 11) (12 15) (45 45 45) (56 56) (69 78) (89 91)) 
            总表及子表均为由大到小排列 
          
返 回 值: 表，子表为按要求排列的 行/列 
 
说    明: 因为是 lisp 函数，本函数内部并不对数据的合法性进行检查，以提高程序的效率 
          使用前确保各参数的的正确性 
|; 
;;******************************************************** 
;;示例一：将文字按要求排序号                               
;;使用前确保已经加载 sortobj.fas                           
;;压缩包内含 sortobj.fas 及 test.dwg (2k DWG)             
;;******************************************************** 
(defun c:t1 (/ ss ssl e elst el n k1 k2 d pre sub) 
  (if (and (setq ss (ssget '((0 . "text")))) 
           (progn 
             (initget "0 1") 
             (setq k1 (getkword "\n[0 -按行/1 -按列]:")) 
           ) 
           (progn 
             (initget "1 2 3 4") 
             (setq k2 
                    (getkword 
                      "\n[1-左上至右下/2-右上至左下/3-右下至左上/4-左下至右上]:" 
                    ) 
             ) 
           ) 
           (setq d (getdist "\n输入允许误差: ")) 
      ) 
    (progn 
      (setq ssl (sslength ss)) 
      (while (> ssl 0) 
        (setq e (ssname ss (setq ssl (1- ssl)))) 
        (setq elst (cons (list (cdr (assoc 10 (entget e))) e) elst)) 
      ) 
      (setq pre        "K+" ;_ 前缀 
            ;;sub        "A" ;_ 后缀 
      ) 
      (setq el (mapcar '(lambda (x) (mapcar 'cadr x)) 
                       (ea:sort_entity elst (atoi k1) (atoi k2) d) 
               ) 
      ) 
      (setq n 1) ;_ 起始值, 
      (mapcar 
        '(lambda (x) 
           (mapcar 
             '(lambda (e1) 
                (setq el (entget e1)) 
                (entmod        (subst (cons 1 
                                     (strcat pre;_ 前缀 
                                             (if (< n 10) 
                                               (strcat "0" (itoa n)) 
                                               (itoa n) 
                                             );_ 可以进行格式化 
                                            ;; sub;_ 后缀 
                                     ) 
                               ) 
                               (assoc 1 el) 
                               el 
                        ) 
                ) 
                (setq n (1+ n)) ;_ 可以定义步距 
              ) 
             x 
           ) 
         ) 
        el 
      ) 
    ) 
  ) 
  (princ) 
) 
;;示例二： 对块中某一属性排序号(可以推广到对多个属性分别排序号)

david96007 · 发表于 2005-1-13 19:05:18

不知道有什么用处？！
如果楼主能把原程序分享给大家就好了！

fools · 发表于 2005-1-14 00:02:10

先顶一下，确实是很实用的通用函数。
因为ssget生成的选择集是按实体生成的顺序排列的，这样的顺序其实相当于无序。
本函数的作用就是按一定规则重新排序，为后续进一步操作做准备。返回值是一个表，第一层子表所含的内容是由前面按行/按列要求决定的，第二层子表为特征点和实体名。eachy的程序已经含有如何提取实体名的示例。
当你需要将cad表格整齐的导入execl，或是希望在cad表格里进行一些有规律的计算，这个函数可以帮助你解决窗选的问题。

eachy · 发表于 2005-1-14 07:01:31

使用范围简单的比如可以用来写文字类“按行连接”、对实体编号，属性块的排轴号、图号，等等，就看自己的需要了。
函数仅对排序部分进行封装，前后处理要自己来做，这样可以适用更广泛的需要

whiteon · 发表于 2005-1-14 07:45:22

不明白,建议楼主用个实例给大家示范一下好吗?

它山之石 · 发表于 2005-1-14 09:25:47

　　程序的功能应该是按实体在图中的平面位置（即XY坐标）来排序。并非按实体的其它特征（如长度、面积、数值大小等）来排序的。

bluesky1000 · 发表于 2005-1-14 10:26:39

这个程序简直是超强！困扰已久的允许误差的排序问题终于解决了，很好用！
但还有个问题，我改了一段程序代码，如下：
 (progn
 (initget "0 1")
 (setq k1 (getkword "\n[0 -按行/1 -按列].<0>:"))
 (if (= k1 nil) (setq k1 "0"))
 )
结果我输入0或者1的时候，程序自动跳出，不能执行下去了，而回车时则正常，这是为什么？

eachy · 发表于 2005-1-14 12:26:16

有写了两个示例，排序函数将修改，关键字支持实数和点表两种形式。
回楼上：查看 initget 的参数
(initget 128 "0 1")

(defun ea:Clearcset (/ cset)
(if (not (vl-catch-all-error-p
(setq cset
(vl-catch-all-apply
'vla-item
(list
(vlax-get-property
(vlax-get-property
(vlax-get-acad-object)
'activedocument
)
'selectionsets
)
"CURRENT"
)
)
)
)
)
(vla-delete cset)
)
(princ)
)
;;实体排序示例三，按行连接文字
;;构造实体表要根据需要决定采用 Object 还是 Entity，这样才能精简代码并提高效率
(vl-load-com)
(defun c:t3 (/ objlst tlst first_obj strlst fstr)
(ea:clearcset);_ 此处必须，原因见以前讨论帖
(princ "\n选择按行连接文字...")
(if (ssget '((0 . "text")))
(progn
;;获取实体表
(vlax-map-collection
(vlax-get-property
(vlax-get-property (vlax-get-acad-object) 'activedocument)
'activeselectionset
)
'(lambda (x)
(setq objlst
(cons (list (vlax-get x 'insertionpoint) x) objlst)
)
(if (not hi)
(setq hi (vlax-get-property x 'height))
) ;_ 取字高作为误差，仅取一次
)
) ;_ end vlax-map-colllection
;;排序并处理
(setq tlst (mapcar '(lambda (x) (mapcar 'cadr x))
(ea:sort_entity objlst 0 1 hi);_ 按行排序
) ;_ 排序后实体表
first_obj (mapcar 'car tlst) ;_每行第一个实体列表
strlst (mapcar '(lambda (x) (mapcar 'vla-get-textstring x))
tlst
) ;_ 每行字符串列表
fstr (mapcar '(lambda (x) (apply 'strcat x)) strlst) ;_合并每行字符串
)
(mapcar '(lambda (a b) (vlax-put-property a 'textstring b))
first_obj
fstr
) ;_ 修改每行第一个文字
(mapcar '(lambda (x) (mapcar 'vla-delete x))
(vl-remove nil (mapcar '(lambda (e) (cdr e)) tlst))
) ;_ 删除每行第二个以后的实体
)
)
(princ)
)
;;排序示例四：行对齐(文字)
(defun c:t4 (/ objlst tlst ptl hi)
(ea:clearcset);_ 此处必须，原因见以前讨论帖
(princ "\n选择按行对齐文字...")
(if (ssget '((0 . "text")))
(progn
;;获取实体表
(vlax-map-collection
(vlax-get-property
(vlax-get-property (vlax-get-acad-object) 'activedocument)
'activeselectionset
)
'(lambda (x / bb uu)
(vla-getboundingbox x 'bb 'uu);_还可以用来做实体对齐
(setq objlst
(cons (list (safearray-value bb) x) objlst)
)
(if (not hi)
(setq hi (vlax-get-property x 'height))
) ;_ 取字高作为误差，仅取一次
)
) ;_ end vlax-map-colllection
;;排序并处理
(setq tlst (ea:sort_entity objlst 0 1 hi);_ 按行排序
objlst (mapcar '(lambda (x) (mapcar 'cadr x))
tlst
) ;_ 排序后实体表
ptl (mapcar '(lambda (x) (caar x)) tlst) ;_每行第一个点
)
(mapcar '(lambda (a b)
(mapcar '(lambda (e)
(vla-move (cadr e)
(vlax-3d-point (car e))
(vlax-3d-point
(list (caar e) (cadr b) 0.)
)
)
)
a
)
)
tlst
ptl
)
)
)
(princ)
)

(defun ea:Clearcset (/ cset) 
  (if (not (vl-catch-all-error-p 
             (setq cset 
                    (vl-catch-all-apply 
                      'vla-item 
                      (list 
                        (vlax-get-property 
                          (vlax-get-property 
                            (vlax-get-acad-object) 
                            'activedocument 
                          ) 
                          'selectionsets 
                        ) 
                        "CURRENT" 
                      ) 
                    ) 
             ) 
           ) 
      ) 
    (vla-delete cset) 
  ) 
  (princ) 
) 
;;实体排序示例三，按行连接文字 
;;构造实体表要根据需要决定采用 Object 还是 Entity，这样才能精简代码并提高效率 
(vl-load-com) 
(defun c:t3 (/ objlst tlst first_obj strlst fstr) 
  (ea:clearcset);_ 此处必须，原因见以前讨论帖 
  (princ "\n选择按行连接文字...") 
  (if (ssget '((0 . "text"))) 
    (progn 
      ;;获取实体表 
      (vlax-map-collection 
        (vlax-get-property 
          (vlax-get-property (vlax-get-acad-object) 'activedocument) 
          'activeselectionset 
        ) 
        '(lambda (x) 
           (setq objlst 
                  (cons (list (vlax-get x 'insertionpoint) x) objlst) 
           ) 
           (if (not hi) 
             (setq hi (vlax-get-property x 'height)) 
           ) ;_ 取字高作为误差，仅取一次 
         ) 
      ) ;_ end vlax-map-colllection 
      ;;排序并处理 
      (setq tlst      (mapcar '(lambda (x) (mapcar 'cadr x)) 
                              (ea:sort_entity objlst 0 1 hi);_ 按行排序 
                      ) ;_ 排序后实体表 
            first_obj (mapcar 'car tlst) ;_每行第一个实体列表 
            strlst    (mapcar '(lambda (x) (mapcar 'vla-get-textstring x)) 
                              tlst 
                      ) ;_ 每行字符串列表 
            fstr      (mapcar '(lambda (x) (apply 'strcat x)) strlst) ;_合并每行字符串 
      ) 
      (mapcar '(lambda (a b) (vlax-put-property a 'textstring b)) 
              first_obj 
              fstr 
      ) ;_ 修改每行第一个文字 
      (mapcar '(lambda (x) (mapcar 'vla-delete x)) 
              (vl-remove nil (mapcar '(lambda (e) (cdr e)) tlst)) 
      ) ;_ 删除每行第二个以后的实体 
    ) 
  ) 
  (princ) 
) 
;;排序示例四：行对齐(文字) 
(defun c:t4 (/ objlst tlst   ptl hi) 
  (ea:clearcset);_ 此处必须，原因见以前讨论帖 
  (princ "\n选择按行对齐文字...") 
  (if (ssget '((0 . "text"))) 
    (progn 
      ;;获取实体表 
      (vlax-map-collection 
        (vlax-get-property 
          (vlax-get-property (vlax-get-acad-object) 'activedocument) 
          'activeselectionset 
        ) 
        '(lambda (x / bb uu) 
           (vla-getboundingbox x 'bb 'uu);_还可以用来做实体对齐 
           (setq objlst 
                  (cons (list (safearray-value bb) x) objlst) 
           ) 
                      (if (not hi) 
             (setq hi (vlax-get-property x 'height)) 
           ) ;_ 取字高作为误差，仅取一次 
         ) 
      ) ;_ end vlax-map-colllection 
      ;;排序并处理 
      (setq tlst   (ea:sort_entity objlst 0 1 hi);_ 按行排序 
            objlst (mapcar '(lambda (x) (mapcar 'cadr x)) 
                           tlst 
                   ) ;_ 排序后实体表 
            ptl           (mapcar '(lambda (x) (caar x)) tlst) ;_每行第一个点 
      ) 
      (mapcar '(lambda (a b) 
                 (mapcar '(lambda (e) 
                            (vla-move (cadr e) 
                                      (vlax-3d-point (car e)) 
                                      (vlax-3d-point 
                                        (list (caar e) (cadr b) 0.) 
                                      ) 
                            ) 
                          ) 
                         a 
                 ) 
               ) 
              tlst 
              ptl 
      ) 
    ) 
  ) 
  (princ) 
)

aeo · 发表于 2005-1-15 23:38:28

最初由 eachy 发布
[B]遗憾，参与者寥寥，这时最后一次更新了(不在提供 fas ，里面包含 vlx 文件)。
[code]
;|
调用格式: (ea:sort_entity entity_list mode key vx)
参数说明:
      1 mode 0 按行 1 按列
      2 key
   ... [/B]

实例二下面没下文了??

很早以前解决的问题了
无非是先排序，再按精度分出来
前面其实方法用过，没特别说明而已.

按精度分，其实很多情况是没精度可言了（用多了就会遇到)
所以要通用，还要考虑没法用精度来衡量的
比如(t t nil nil t t t t nil 1 1 1 t ) 等等

eachy · 发表于 2005-1-15 23:52:47

最初由 aeo 发布
[B][QUOTE]最初由 eachy 发布
[B]遗憾，参与者寥寥，这时最后一次更新了(不在提供 fas ，里面包含 vlx 文件)。
[code]
;|
调用格式: (ea:sort_entity entity_list mode key vx)
参数说明:
1 mode... [/B]

我也没有遇到过其他情况的需要，只有按位置排序的需求，示例二不再贴了，原因1楼帖子已经说明，原本打算给积极参与者赠送排序源码的，现在不可能了。其实排序部分也不难，就看其效率了。现在正写一个对话框版的排序，会提供给大家

bluesky1000 · 发表于 2005-1-16 09:31:29

这个对话框版本很不错，但是有一个小小的建议给EACHY斑竹，那就是在行差这里能否做一个按钮，点取后可直接在屏幕上点选二点的距离作为行差，这样的实用性才更强，不是吗？
还有那个序号，是起始值吗？属性编号什么意思？
说实在的，EACHY斑竹的这个程序我认为比ET，文修大师、论坛里的此类程序要强得多，希望EACHY斑竹能早日把这个程序新鲜出炉！

梦断江南 · 发表于 2005-1-16 10:09:54

与ea共勉
本函数未考虑允许误差,但支持多纬数组排序和元素不等数组,可自定义排序次序,支持用函数进行排序判断

;;////////////////////////////////////////////////////////////////////////////////;;
;;(xsort lst dolst)=对多维数组排序，按照执行的先后(最先执行的具有结果的最优先权)
;|详细说明:
xsort=对多维数组排序，按照执行的先后(最后执行的具有结果的最优先)
参数: lst = 要排序的数组,
dolst = 按位排序所依据的函数列表 = '((i0 func0) (i1 func1) (i2 func2) ...) ;
i* 为要进行排序的维度(元素中第n元素，不需要按照顺序)
func* 分别对应数组lst元素(维,也是表)中的元素序列.
func*可以是任何自定义的含2个参数的函数(注意函数中要对参数为nil时候的判断).如:(< nil 3)=T,(< 3 nil)=nil
注: i* 可根据需要自由设定次序.
实例:
1.(xsort '((0 1)(2 1)(0 2)(3 0)(3 1)(2 3)(1 0)(2 0)(1 1)(1 2)(1 3)) '((0 <) (1 <)))
-> ((0 1) (0 2) (1 0) (1 1) (1 2) (1 3) (2 0) (2 1) (2 3) (3 0) (3 1))
2.(xsort '((0 1)(2 1)(0 2)(3 0)(3 1)(2 3)(1 0)(2 0)(1 1)(1 2)(1 3)) '((1 <) (0 <)))
-> ((1 0) (2 0) (3 0) (0 1) (1 1) (2 1) (3 1) (0 2) (1 2) (1 3) (2 3))
3.(xsort '((1 0 1 0)(2 0 1 1)(2 2 2 1)(1 1 2 1)(1 1 1 3)) '((1 <) (3 >) (0 <) (2 <)))
-> ((2 0 1 1) (1 0 1 0) (1 1 1 3) (1 1 2 1) (2 2 2 1))
4.(xsort '((1 0 1 0)(2 3 1 1)(2 2 2 1)(1 0 2 1)(1 1 1 1)) '((0 <) (2 >) nil (4 >)))
-> ((1 0 2 1) (1 0 1 0) (1 1 1 1) (2 2 2 1) (2 3 1 1))
6.支持不等维数组.当对应dolst表中func* 不为nil时，维数大的优先.
(xsort '((1 0 1)(2 3 1 1 3)(2 2 1)(1 0 2 1)(1 1 1 1 1)) '((0 <) (2 >) (1 <) nil (4 >)))
-> ((1 0 2 1) (1 0 1) (1 1 1 1 1) (2 2 1) (2 3 1 1 3))
(xsort '((1 0 1)(2 3 1 1 3)(2 2 1)(1 0 2 1)(1 1 1 1 1)(2 0 2)) '((0 <) (1 >) (2 <) (3 >) (4 >)))
-> ((1 1 1 1 1) (1 0 1) (1 0 2 1) (2 3 1 1 3) (2 2 1) (2 0 2))
7.func*的灵活运用.可以是任何自定义的含2个参数的函数(注意函数中要对参数为nil时候的判断).如:(< nil 3)=T,(< 3 nil)=nil
;如下 (xrem x y)
;测试:(xrem 7 9) -> nil ;; (rem 7 3)= 1,(rem 9 3)= 0 ,(< 1 0)= nil.
代入xosrt: (xsort '((12 3)(7 4)(5 1)(4 4)(2 5)(3 4)(4 3)(3 1)(3 5)(4 2)(2 3)) '((0 <) (1 xrem)))
返回 -> ((2 3) (2 5) (3 4) (3 1) (3 5) (4 3) (4 4) (4 2) (5 1) (7 4) (12 3))
(xsort '((12 3)(7 4)(5 1)(4 4)(2 5)(3 4)(4)(3 1)(3 5)(4 2)(2 3 3)) '((0 <) (1 xrem)))
-> ((2 3 3) (2 5) (3 4) (3 1) (3 5) (4) (4 4) (4 2) (5 1) (7 4) (12 3))
|;
(defun xrem (x y)
(if (or (and (= nil x) y)
(and x y (< (rem x 3)(rem y 3))))
T
nil)
)

;;////////////////////////////////////////////////////////////////////////////////;; 
;;(xsort lst dolst)=对多维数组排序，按照执行的先后(最先执行的具有结果的最优先权) 
 
;|详细说明: 
 
xsort=对多维数组排序，按照执行的先后(最后执行的具有结果的最优先) 
参数: lst   = 要排序的数组, 
      dolst = 按位排序所依据的函数列表 = '((i0 func0) (i1 func1) (i2 func2) ...) ; 
              i* 为要进行排序的维度(元素中第n元素，不需要按照顺序) 
              func* 分别对应数组lst元素(维,也是表)中的元素序列. 
              func*可以是任何自定义的含2个参数的函数(注意函数中要对参数为nil时候的判断).如:(< nil 3)=T,(< 3 nil)=nil 
注:   i* 可根据需要自由设定次序.               
实例: 
1.(xsort '((0 1)(2 1)(0 2)(3 0)(3 1)(2 3)(1 0)(2 0)(1 1)(1 2)(1 3)) '((0 <) (1 <))) 
-> ((0 1) (0 2) (1 0) (1 1) (1 2) (1 3) (2 0) (2 1) (2 3) (3 0) (3 1)) 
2.(xsort '((0 1)(2 1)(0 2)(3 0)(3 1)(2 3)(1 0)(2 0)(1 1)(1 2)(1 3)) '((1 <) (0 <))) 
-> ((1 0) (2 0) (3 0) (0 1) (1 1) (2 1) (3 1) (0 2) (1 2) (1 3) (2 3))   
3.(xsort '((1 0 1 0)(2 0 1 1)(2 2 2 1)(1 1 2 1)(1 1 1 3)) '((1 <) (3 >) (0 <) (2 <))) 
-> ((2 0 1 1) (1 0 1 0) (1 1 1 3) (1 1 2 1) (2 2 2 1))   
4.(xsort '((1 0 1 0)(2 3 1 1)(2 2 2 1)(1 0 2 1)(1 1 1 1)) '((0 <) (2 >) nil (4 >))) 
-> ((1 0 2 1) (1 0 1 0) (1 1 1 1) (2 2 2 1) (2 3 1 1))   
6.支持不等维数组.当对应dolst表中func* 不为nil时，维数大的优先. 
(xsort '((1 0 1)(2 3 1 1 3)(2 2 1)(1 0 2 1)(1 1 1 1 1)) '((0 <) (2 >) (1 <) nil (4 >))) 
-> ((1 0 2 1) (1 0 1) (1 1 1 1 1) (2 2 1) (2 3 1 1 3)) 
(xsort '((1 0 1)(2 3 1 1 3)(2 2 1)(1 0 2 1)(1 1 1 1 1)(2 0 2)) '((0 <) (1 >) (2 <) (3 >) (4 >))) 
-> ((1 1 1 1 1) (1 0 1) (1 0 2 1) (2 3 1 1 3) (2 2 1) (2 0 2)) 
7.func*的灵活运用.可以是任何自定义的含2个参数的函数(注意函数中要对参数为nil时候的判断).如:(< nil 3)=T,(< 3 nil)=nil 
;如下 (xrem x y) 
;测试:(xrem 7 9) -> nil ;; (rem 7 3)= 1,(rem 9 3)= 0 ,(< 1 0)= nil. 
代入xosrt:  (xsort '((12 3)(7 4)(5 1)(4 4)(2 5)(3 4)(4 3)(3 1)(3 5)(4 2)(2 3)) '((0 <) (1 xrem))) 
      返回 -> ((2 3) (2 5) (3 4) (3 1) (3 5) (4 3) (4 4) (4 2) (5 1) (7 4) (12 3)) 
      (xsort '((12 3)(7 4)(5 1)(4 4)(2 5)(3 4)(4)(3 1)(3 5)(4 2)(2 3 3)) '((0 <) (1 xrem))) 
      -> ((2 3 3) (2 5) (3 4) (3 1) (3 5) (4) (4 4) (4 2) (5 1) (7 4) (12 3)) 
|; 
(defun xrem (x y) 
  (if (or (and (= nil x) y) 
          (and x y (< (rem x 3)(rem y 3)))) 
      T 
      nil) 
)

[php]
;实战测试:
;ptsort = 在屏幕点选，调用xsort排序点表，并按排序次序标注序号.
(defun c:ptsort (/ pt lst i) ;ptlst 全局.
 (vl-cmdf ".undo" "be")
 (while (and (princ "\n取点<上一组点表>:") (setq pt (getpoint)))
(setq lst (cons pt lst))
 )
 (setq ptlst (if lst lst ptlst))
 (setq i 0)
 (if ptlst
(foreach n (xsort ptlst '((0 <) (1 <)))
 (vl-cmdf ".text" n "500" "0" (itoa (setq i (1+ i))) "")
)
 )
 (vl-cmdf ".undo" "e")
 (princ)
)
[/php]
附件含 xsort 函数及 c:ptsort (加载xsort.fas)

梦断江南 · 发表于 2005-1-16 10:11:25

ptsort演示

fools · 发表于 2005-1-16 12:14:25

最初由 eachy 发布
[B][QUOTE]最初由 aeo 发布
[B][QUOTE]最初由 eachy 发布
[B]遗憾，参与者寥寥，这时最后一次更新了(不在提供 fas ，里面包含 vlx 文件)。
[code]
;|
调用格式: (ea:sort_entity entity_list mode k... [/B]

排序函数的效率是关键，特别对于排序的选择集数量较多时。
我原先的程序中为了实现这样的排序效果是用两个循环镶套的，循环次数是选择集数量的平方，这应该不是很好的算法，但又想不到更好的。

eachy · 发表于 2005-1-16 12:57:45

个人意见，lisp 函数也不要太通用，根据功能的需要写写函数是可以提高编程效率，但不一定提高程序的运行效率。以前也曾经写过N多各种的函数，现在看那些很多都不适宜了。

回楼上，本函数仅和你提供的表有关，与UCS无关。

账号		自动登录	找回密码
密码			立即注册

[原创]：通用实体排序函数(更新)

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [原创]：通用实体排序函数(更新)

Re: Re: [原创]：通用实体排序函数(更新)

Re: Re: Re: [原创]：通用实体排序函数(更新)