通用函数 选择集按照给定组码排序.LSP
zml84
zml84 Lv.2
2010年12月07日 10:08:26
只看楼主

通用函数 选择集按照给定组码排序.LSP;;; 通用函数 选择集按照给定的组码值进行排序;;;;|;;参数说明:SE ----要排序的选择集 DXF ----排序依据的组码号 INT ----如果组码值为一个表,则INT指出使用第几个;否则nil FUZZ----允许偏差;若无为nil K ----T表示从大到小,nil表示从小到大 返回值:排序后的选择集 示例:(SORT-SE SS 10 0 5.0 T ) 表示按照10组码的X坐标值进行排序,允许偏差值为5.0,顺序为从大到小

通用函数 选择集按照给定组码排序.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 (* 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))
免费打赏
lls123
2010年12月07日 12:48:39
2楼
好东东啊谢谢楼主
回复

相关推荐

APP内打开