选择集按照给定组码排序

分类:lisp函数 | 标签: lisp   排序   选择集  
2007-09-17 11:14 阅读(?)评论(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)
)
   阅读(?)评论(0)
 
表  情:
加载中...
 

请各位遵纪守法并注意语言文明