[LISP程序]：选择集的排序问题

lsjjm

用ssget 创建的选择集是按其实体生成的顺序排列的. 如果用户需要按某一种方式排序, 例如按X坐标可利用acet函数:
(defun c:test ()
  (setq ss (ssget))
  (setq tt (acet-ss-sort ss 'getx))
)
(defun getx (ent)
  (car (cdr (assoc 10 ent)))
)

zml84

;;; 通用函数 选择集按照给定的组码值进行排序
;;;
;|;;参数说明：SE  ----要排序的选择集                                                                  
              DXF ----排序依据的组码号                                                                 
              INT ----如果组码值为一个表，则INT指出使用第几个；否则nil                                 
              FUZZ----允许偏差；若无为nil                                                              
              K   ----T表示从大到小，nil表示从小到大                                                   
    返回值：排序后的选择集                                                                             
    示例：(SORT-SE SS 10 0   5.0 T  )  表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
          (SORT-SE SS 10 1   3.0 NIL)  表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大
          (SORT-SE SS 8  NIL NIL NIL)  表示按照8组码值（图层名称）进行排序，顺序为从小到大            
|;
(vl-load-com)
(defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
    ;;建立排序列表
    (setq LST '()
          INDEX        0
    )
    (repeat (sslength SE)
        (setq ENT (entget (ssname SE INDEX))
              TMP (cdr (assoc DXF ENT))
        )
        (if (and INT
                 (= (type INT) 'INT)
                 (= (type TMP) 'list)
                 (< INT (length TMP))
            )
            (setq TMP (nth INT TMP))
        )
        (setq LST (cons
                      (list TMP (cdr (assoc 5 ENT)))
                      LST
                  )
        )
        (setq INDEX (1+ INDEX))
    )
    ;;排序操作
    (if        (and FUZZ
             (or
                 (= (type FUZZ) 'INT)
                 (= (type FUZZ) 'REAL)
             )
             (or
                 (= (type TMP) 'INT)
                 (= (type TMP) 'REAL)
             )
        )
        (setq NEWLST
                 (vl-sort LST
                          (function (lambda (E1 E2)
                                        (< (+ (car E1) FUZZ) (car E2))
                                    )
                          )
                 )
        )
        (setq NEWLST
                 (vl-sort LST
                          (function (lambda (E1 E2)
                                        (< (car E1) (car E2))
                                    )
                          )
                 )
        )
    )
    ;;如果K为T，则倒置
    (if        K
        (setq NEWLST (reverse NEWLST))
    )
    ;;组织排序后的选择集
    (setq NEWSE (ssadd))
    (foreach TMP NEWLST
        (setq NEWSE (ssadd (handent (cadr TMP)) NEWSE))
    )
    ;;返回值
    NEWSE
) ;_结束defun
;;;=============================================================
;;;测试
(defun C:TT (/ S1 S2 I SIZE)
    (if        (setq S1 (ssget '((0 . "TEXT"))))
        (progn
            ;;
            (setq SIZE (cdr (assoc 40 (entget (ssname S1 0)))))
            ;;排序
;;;            ;;x坐标排序：
;;;            (setq S2 (SORT-SE S1 10 0 (* 0.6 SIZE) nil))
;;;            ;;y坐标排序：
;;;            (setq S2 (SORT-SE S1 10 1 (* 0.6 SIZE) t))
            ;;先y后x排序：
            (setq S2 (SORT-SE (SORT-SE S1 10 1 (* 0.4 SIZE)nil)
                              10
                              0
                              (* 0.8 SIZE)
                              nil
                     )
            )
;;;            ;;按照颜色排序：
;;;            (setq S2 (SORT-SE S1 62 nil nil nil))
;;;            ;;按照内容排序：
;;;            (setq S2 (SORT-SE S1 1 nil nil nil))
            ;;
            (setq I 0)
            (repeat (sslength S2)
                (princ "\n")
                (princ (cdr (assoc 1 (entget (ssname S2 I)))))
                (setq I (1+ I))
            )
        )
    )
    (princ)
)

LUCAS

;;終於有人想用ACET的功能
.......
(acet-ss-annotation-filter ss)                    ;defined "acetutil4.fas"
        acet-ss-clear-prev
(acet-ss-convert-ellipses-to-plines ss)           ;defined "acetutil3.fas"
        acet-ss-entdel
(acet-ss-filter arglst)                           ;defined  "acetutil2.fas"   
(acet-ss-filter-current-ucs ss printflag)         ;defined "acetutil2.fas"   
(acet-ss-filter-item ss a)                        ;defined "acetutil2.fas"   
(acet-ss-filter-validate flt)                     ;defined "acetutil2.fas"   
        acet-ss-flt-cspace
(acet-ss-intersection SS1 SS2)                    ;defined "acetutil4.fas"
        acet-ss-new
(acet-ss-redraw ss flag)                          ;defined "acetutil3.fas"
(acet-ss-remove SS1 SS2)                          ;defined "acetutil4.fas"
(acet-ss-remove-dups ss fuz ignore)               ;defined "acetutil4.fas"
(acet-ss-remove-dups-extents-list ss fuz)         ;defined "acetutil4.fas"
(acet-ss-remove-dups-generalize-ent na fuz gclst) ;defined "acetutil4.fas"
(acet-ss-remove-dups-reverse lst)                 ;defined "acetutil4.fas"
(acet-ss-scale-to-fit ss p1 p2 border)            ;defined "acetutil3.fas"
(acet-ss-scale-to-fit-base p1 p2 sf)              ;defined "acetutil2.fas"   
(acet-ss-sort ss func)                            ;defined "acetutil4.fas"
(acet-ss-ssget-filter ss flt)                     ;defined "acetutil2.fas"   
(acet-ss-to-list ss)                              ;defined "acetutil2.fas"   
(acet-ss-union SSLIST)                            ;defined "acetutil2.fas"   
        acet-ss-visible
(acet-ss-zoom-extents ss)                         ;defined "acetutil3.fas"
...........

小菜

ACET函数的文档哪里有呢？

lsjjm

express tool

小菜

我的express tools里面没有acet的函数说明呀，只有express的命令

lsjjm

最初由 小菜 发布
[B]我的express tools里面没有acet的函数说明呀，只有express的命令 [/B]

EXPRESSTOOLS目录下的大多数LISP函数里边都有。
或者使用下面的程序查询：
http://www.xdcad.net/forum/showthread.php?threadid=146898

小菜

知道名字但不知道调用参数和返回值，以及做什么用

lsjjm

www.afralisp.com/www.autocad.ru 等介绍了一些。

小菜

真不容易，一个英文一个俄文，怎么看得懂，进去一下，连北都找不着

nessus

哪有中文版的啊，有就好了。

xfyy

哪有中文版的啊

heike4

EXPRESSTOOLS 有汉化版的啊

fjutcivil

mark                    !