lisp程序-选择集排序函数

lisp程序-选择集排序函数.txt我的人生有A 面也有B面，你的人生有S面也有B面。失

败不可怕，关键看是不是成功他妈。现在的大学生太没素质了！过来拷毛片，居然用剪切！

有空学风水去，死后占个好墓也算弥补了生前买不起好房的遗憾。百度空间 | 百度首页 | 登

录花季祝福路过我空间的朋友新年快乐虎年大吉主页博客相册|个人档案 |好友查看

文章

选择集按照给定组码排序2009年06月19日星期五 19:47通用函数选择集按照给定组码

排序.LSP

--------------------------------------------------------------------------------

;;; 通用函数选择集按照给定的组码值进行排序

;;;

;|;;参数说明：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.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)

)