(XD::List:TableSort)对点索引表进行行/列排序

eachy · 发表于 2013-6-30 15:54:56

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

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

×

;;Author： eachy
(defun XD::List:TableSort (lst row bp fuzz / nlst n nnlst)
(and
(listp (caar lst))
(or
(and
(zerop row)
(or (and (member bp '(0 1))
(setq
nlst
(vl-sort lst
'(lambda (e1 e2) (> (cadar e1) (cadar e2)))
)
)
)
(and (member bp '(2 3))
(setq
nlst
(vl-sort lst
'(lambda (e1 e2) (< (cadar e1) (cadar e2)))
)
)
)
)
(setq nnlst (list (list (car nlst))))
(while (setq nlst (cdr nlst))
(setq n (car nlst))
(if (equal (cadar n) (cadr (caaar nnlst)) fuzz)
(setq
nnlst (cons (cons (caar nnlst) (cons n (cdar nnlst)))
(cdr nnlst)
)
)
(setq nnlst (cons (list n) nnlst))
)
)
(or
(and (= bp 0)
(setq nnlst (mapcar '(lambda (x)
(if (> (length x) 1)
(vl-sort
x
(function
(lambda (a b)
(if (= (caar a) (caar b))
(< (cadar a) (cadar b))
(< (caar a) (caar b))
)
)
)
)
x
)
)
nnlst
)
)
)
(and (= bp 1)
(setq nnlst
(mapcar '(lambda (x)
(if (> (length x) 1)
(vl-sort x
'(lambda (a b)
(if (= (caar a) (caar b))
(< (cadar a) (cadar b))
(> (caar a) (caar b))
)
)
)
x
)
)
nnlst
)
)
)
(and (= bp 2)
(setq
nnlst
(mapcar '(lambda (x)
(if (> (length x) 1)
(vl-sort x
'(lambda (a b)
(if (= (caar a) (caar b))
(> (cadar a) (cadar b))
(> (caar a) (caar b))
)
)
)
x
)
)
nnlst
)
)
)
(and (= bp 3)
(setq
nnlst
(mapcar '(lambda (x)
(if (> (length x) 1)
(vl-sort x
'(lambda (a b)
(if (= (caar a) (caar b))
(> (cadar a) (cadar b))
(< (caar a) (caar b))
)
)
)
x
)
)
nnlst
)
)
)
)
)
(and (= row 1)
(or (and (member bp '(0 3))
(setq nlst (vl-sort lst
(function (lambda (e1 e2)
(> (caar e1) (caar e2))
)
)
)
)
)
(and (member bp '(1 2))
(setq nlst (vl-sort lst
'(lambda (e1 e2)
(< (caar e1) (caar e2))
)
)
)
)
)
(setq nnlst (list (list (car nlst))))
(while (setq nlst (cdr nlst))
(setq n (car nlst))
(if (equal (caar n) (caaaar nnlst) fuzz)
(setq
nnlst (cons (cons (caar nnlst) (cons n (cdar nnlst)))
(cdr nnlst)
)
)
(setq nnlst (cons (list n) nnlst))
)
)
(or
(and (= bp 0)
(setq nnlst
(mapcar
'(lambda (x)
(if (> (length x) 1)
(vl-sort x
'(lambda (a b)
(if (= (cadar a) (cadar b))
(< (caar a) (caar b))
(< (cadar a) (cadar b))
)
)
)
x
)
)
nnlst
)
)
)
(and (= bp 1)
(setq nnlst
(mapcar
'(lambda (x)
(if (> (length x) 1)
(vl-sort x
'(lambda (a b)
(if (= (cadar a) (cadar b))
(> (caar a) (caar b))
(< (cadar a) (cadar b))
)
)
)
x
)
)
nnlst
)
)
)
(and (= bp 2)
(setq nnlst
(mapcar '(lambda (x)
(if (> (length x) 1)
(vl-sort x
'(lambda (a b)
(if (= (cadar a) (cadar b))
(> (caar a) (caar b))
(> (cadar a) (cadar b))
)
)
)
x
)
)
nnlst
)
)
)
(and (= bp 3)
(setq nnlst
(mapcar '(lambda (x)
(if (> (length x) 1)
(vl-sort x
'(lambda (a b)
(if (= (cadar a) (cadar b))
(< (caar a) (caar b))
(> (cadar a) (cadar b))
)
)
)
x
)
)
nnlst
)
)
)
)
)
)
)
nnlst
)

;;Author： eachy 
(defun XD::List:TableSort (lst row bp fuzz / nlst n nnlst) 
  (and 
    (listp (caar lst)) 
    (or 
      (and 
        (zerop row) 
        (or (and (member bp '(0 1)) 
                 (setq 
                   nlst 
                    (vl-sort lst 
                             '(lambda (e1 e2) (> (cadar e1) (cadar e2))) 
                    ) 
                 ) 
            ) 
            (and (member bp '(2 3)) 
                 (setq 
                   nlst 
                    (vl-sort lst 
                             '(lambda (e1 e2) (< (cadar e1) (cadar e2))) 
                    ) 
                 ) 
            ) 
        ) 
        (setq nnlst (list (list (car nlst)))) 
        (while (setq nlst (cdr nlst)) 
          (setq n (car nlst)) 
          (if (equal (cadar n) (cadr (caaar nnlst)) fuzz) 
            (setq 
              nnlst (cons (cons (caar nnlst) (cons n (cdar nnlst))) 
                          (cdr nnlst) 
                    ) 
            ) 
            (setq nnlst (cons (list n) nnlst)) 
          ) 
        ) 
        (or 
          (and (= bp 0) 
               (setq nnlst (mapcar '(lambda (x) 
                                      (if (> (length x) 1) 
                                        (vl-sort 
                                          x 
                                          (function 
                                            (lambda (a b) 
                                              (if (= (caar a) (caar b)) 
                                                (< (cadar a) (cadar b)) 
                                                (< (caar a) (caar b)) 
                                              ) 
                                            ) 
                                          ) 
                                        ) 
                                        x 
                                      ) 
                                    ) 
                                   nnlst 
                           ) 
               ) 
          ) 
          (and (= bp 1) 
               (setq nnlst 
                      (mapcar '(lambda (x) 
                                 (if (> (length x) 1) 
                                   (vl-sort x 
                                            '(lambda (a b) 
                                               (if (= (caar a) (caar b)) 
                                                 (< (cadar a) (cadar b)) 
                                                 (> (caar a) (caar b)) 
                                               ) 
                                             ) 
                                   ) 
                                   x 
                                 ) 
                               ) 
                              nnlst 
                      ) 
               ) 
          ) 
          (and (= bp 2) 
               (setq 
                 nnlst 
                  (mapcar '(lambda (x) 
                             (if (> (length x) 1) 
                               (vl-sort        x 
                                        '(lambda (a b) 
                                           (if (= (caar a) (caar b)) 
                                             (> (cadar a) (cadar b)) 
                                             (> (caar a) (caar b)) 
                                           ) 
                                         ) 
                               ) 
                               x 
                             ) 
                           ) 
                          nnlst 
                  ) 
               ) 
          ) 
          (and (= bp 3) 
               (setq 
                 nnlst 
                  (mapcar '(lambda (x) 
                             (if (> (length x) 1) 
                               (vl-sort        x 
                                        '(lambda (a b) 
                                           (if (= (caar a) (caar b)) 
                                             (> (cadar a) (cadar b)) 
                                             (< (caar a) (caar b)) 
                                           ) 
                                         ) 
                               ) 
                               x 
                             ) 
 
                           ) 
                          nnlst 
                  ) 
               ) 
          ) 
        ) 
      ) 
      (and (= row 1) 
           (or (and (member bp '(0 3)) 
                    (setq nlst (vl-sort        lst 
                                        (function (lambda (e1 e2) 
                                                    (> (caar e1) (caar e2)) 
                                                  ) 
                                        ) 
                               ) 
                    ) 
               ) 
               (and (member bp '(1 2)) 
                    (setq nlst (vl-sort        lst 
                                        '(lambda (e1 e2) 
                                           (< (caar e1) (caar e2)) 
                                         ) 
                               ) 
                    ) 
               ) 
           ) 
           (setq nnlst (list (list (car nlst)))) 
           (while (setq nlst (cdr nlst)) 
             (setq n (car nlst)) 
             (if (equal (caar n) (caaaar nnlst) fuzz) 
               (setq 
                 nnlst (cons (cons (caar nnlst) (cons n (cdar nnlst))) 
                             (cdr nnlst) 
                       ) 
               ) 
               (setq nnlst (cons (list n) nnlst)) 
             ) 
           ) 
           (or 
             (and (= bp 0) 
                  (setq        nnlst 
                         (mapcar 
                           '(lambda (x) 
                              (if (> (length x) 1) 
                                (vl-sort x 
                                         '(lambda (a b) 
                                            (if        (= (cadar a) (cadar b)) 
                                              (< (caar a) (caar b)) 
                                              (< (cadar a) (cadar b)) 
                                            ) 
                                          ) 
                                ) 
                                x 
                              ) 
                            ) 
                           nnlst 
                         ) 
                  ) 
             ) 
             (and (= bp 1) 
                  (setq        nnlst 
                         (mapcar 
                           '(lambda (x) 
                              (if (> (length x) 1) 
                                (vl-sort x 
                                         '(lambda (a b) 
                                            (if        (= (cadar a) (cadar b)) 
                                              (> (caar a) (caar b)) 
                                              (< (cadar a) (cadar b)) 
                                            ) 
                                          ) 
                                ) 
                                x 
                              ) 
                            ) 
                           nnlst 
                         ) 
                  ) 
             ) 
             (and (= bp 2) 
                  (setq        nnlst 
                         (mapcar '(lambda (x) 
                                    (if        (> (length x) 1) 
                                      (vl-sort x 
                                               '(lambda        (a b) 
                                                  (if (= (cadar a) (cadar b)) 
                                                    (> (caar a) (caar b)) 
                                                    (> (cadar a) (cadar b)) 
                                                  ) 
                                                ) 
                                      ) 
                                      x 
                                    ) 
 
                                  ) 
                                 nnlst 
                         ) 
                  ) 
             ) 
             (and (= bp 3) 
                  (setq        nnlst 
                         (mapcar '(lambda (x) 
                                    (if        (> (length x) 1) 
                                      (vl-sort x 
                                               '(lambda        (a b) 
                                                  (if (= (cadar a) (cadar b)) 
                                                    (< (caar a) (caar b)) 
                                                    (> (cadar a) (cadar b)) 
                                                  ) 
                                                ) 
                                      ) 
                                      x 
                                    ) 
                                  ) 
                                 nnlst 
                         ) 
                  ) 
             ) 
           ) 
      ) 
    ) 
  ) 
  nnlst 
)

eachy · 发表于 2013-6-30 15:59:20

应用参考
http://bbs.xdcad.net/forum.php?m ... p;extra=#pid3453847

Lisphk · 发表于 2013-6-30 16:24:38

支持eachy大师，有问题请教，我工作中，有很多时候是在UCS PLAN 下画图，这样可以充分利用图面。请问，在这种UCS下，这个函数可以用吗？

eachy · 发表于 2013-6-30 17:05:20

Lisphk 发表于 2013-6-30 16:24
支持eachy大师，有问题请教，我工作中，有很多时候是在UCS PLAN 下画图，这样可以充分利用图面。请问，在这 ...

不管UCS还是WCS，表现出来的就是数，排序只和数有关，至于怎么用这个数是你要先行处理的。

GTJ116600 · 发表于 2013-7-1 05:14:30

本帖最后由 GTJ116600 于 2013-7-1 05:16 编辑

呵呵，大师，这个函数好呀。这就是实体空间排序呀！！！
对用CAD做管理类的相关部门，用处飞常好呀。{:soso_e113:}
顶，大师

GTJ116600 · 发表于 2013-7-1 05:26:43

大师，能否再进一步，编一个点按在空间曲线实体的走向（点在空间曲线上的投影）进行排序。这样，实体空间特征点就可以根据用户的需要，在空间进行随机排序了。

Free-Lancer · 发表于 2013-7-1 06:10:31

GTJ116600 发表于 2013-7-1 05:26
大师，能否再进一步，编一个点按在空间曲线实体的走向（点在空间曲线上的投影）进行排序。这样，实体空间特 ...

http://www.xdcad.net/forum/forum.php?mod=viewthread&tid=668841
http://www.xdcad.net/forum/forum.php?mod=viewthread&tid=668455
http://www.xdcad.net/forum/forum.php?mod=viewthread&tid=143822

eachy · 发表于 2013-12-6 19:44:30

1206 更新

eachy · 发表于 2013-12-7 09:40:33

1207 updata

wjl1014 · 发表于 2014-11-30 12:14:06

能否详细介绍一下用法。

XDSoft · 发表于 2014-11-30 12:17:20

wjl1014 发表于 2014-11-30 12:14
能否详细介绍一下用法。

去看下楼上 2楼，7楼的链接，多看代码。

laiz3000 · 发表于 2015-5-25 22:30:01

学习排序，收藏一下

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

[表] (XD::List:TableSort)对点索引表进行行/列排序

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

点评

点评

点评