master

分支 (2)

管理

管理

master

dev

abfl
/
sel-utils.lsp

;|
处理选择集类函数
|;

;;;name:BF-pickset-ssget
;;;desc:自定义带提示符的ssget / 参照 leemac大神
;;;arg:msg:提示符
;;;arg:params:ssget参数列表
;;;return:选择集
;;;example:(BF-pickset-ssget "选择对象：" '("_WP" pt_list ((0 . "LINE") (62 . 5))))
(defun BF-pickset-ssget (msg params / sel)
	(princ msg)
	(setvar 'nomutt 1)
	(setq sel (vl-catch-all-apply 'ssget params))
	(setvar 'nomutt 0)
	(if (not (vl-catch-all-error-p sel)) sel)
)

;;;name:BF-pickset-getbox
;;;desc:选择集包围盒
;;;arg:sel:选择集
;;;arg:offset:外框偏移距离
;;;等于0 / nil，不偏移
;;;大于0，向外偏移
;;;小于0，向内偏移
;;;return:外框（偏移后）的左下，右上角点
;;;example:(BF-pickset-getbox sel 0.2)
(defun BF-pickset-getbox (sel offset / ptlist)
	(setq ptlist
		(apply 'append (mapcar '(lambda (x) (BF-ent-getbox x offset)) (BF-pickset->list sel))))
	(list
		(apply 'mapcar (cons 'min ptlist))
		(apply 'mapcar (cons 'max ptlist)))
)

;;;name:BF-pickset-ptx
;;;desc:取选择集4角点坐标
;;;arg:sel:选择集
;;;arg:n:角点编号
;;;左下 0
;;;右下 1
;;;右上 2
;;;左上 3
;;;return:角点坐标
;;;example:(BF-pickset-ptx sel 0)
(defun BF-pickset-ptx (sel n / ptlist)
  (setq ptlist (BF-pickset-getbox sel 0))
	(nth n (BF-rec-2pt->4pt (car ptlist) (cadr ptlist)))
)


;;;name:BF-pickset-sortwithdxf
;;;desc:选择集按照给定的组码值进行排序
;;;arg:SE:要排序的选择集
;;;arg:I:排序依据的组码号
;;;arg:INT:如果组码值为一个表，则INT指出使用第几个；否则nil
;;;arg:FUZZ:允许偏差；若无为nil
;;;arg:K:T表示从大到小，nil表示从小到大返回值：
;;;return:排序后的选择集
;;;example:(SORT-SE SS 10 0 5.0 T)表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
;;;(SORT-SE SS 10 0 5.0 T)表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
;;;(SORT-SE SS 8 NIL NIL NIL)表示按照8组码值（图层名称）进行排序，顺序为从小到大
(defun BF-pickset-sortwithdxf (SE i 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 i 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

;;;name:BF-pickset-sort
;;;desc:通用选择集，点表，图元列表排序,本程序是在fsxm的扩展 自贡黄明儒 2014年3月22日
;;;arg:ssPts:选择集，点表，图元列表
;;;arg:KEY:xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先，小y表示从小到大(注:二维点时，不能有z)
;;;arg:FUZZ:允许偏差；若无为nil
;;;return:结果根据ssPts不同，如下：
;;;选择集，返回图元列表ssPts
;;;点表(1到n维 1维时key只能是x或X)，返回点表,点表可以1到n维混合,Key长度不大于点的最小维数。
;;;图元列表，返回图元列表
;;;example:(BF-pickset-Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
;;;(BF-pickset-Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
;;;(BF-pickset-Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
;;;(BF-pickset-Sort (list "DF" "ZX" "A" "DD" "A") "X" 1)=>("ZX" "DF" "DD" "A" "A")
;;;(BF-pickset-Sort (list 5 8 5 9) "X" 1)=>(9 8 5)
(defun BF-pickset-sort (ssPts KEY FUZZ / E EN FUN LST N sortpts sortpts1)
  ;;1 点列表排序
  (defun sortpts (PTS FUN xyz FUZZ)
    (vl-sort pts
			'(lambda (a b)
				 (if (not (equal (xyz a) (xyz b) fuzz))
					 (fun (xyz a) (xyz b))
				 )
			 )
    )
  )
  ;;2 排序
  (defun sortpts1 (PTS KEY FUZZ)
    (setq Key (vl-string->list Key))
    (foreach xyz (reverse Key)
      (cond ((< xyz 100)
							(setq fun >)
							(setq xyz (nth (- xyz 88) (list car cadr caddr)))
						)
				(T
					(setq fun <)
					(setq xyz (nth (- xyz 120) (list car cadr caddr)))
				)
      )
      (setq Pts (sortpts Pts fun xyz fuzz))
    )
  )
  ;;3 本程序主程序
  (cond
    ((= (type ssPts) 'PICKSET)
      (repeat (setq n (sslength ssPts))
        (if (and (setq e (ssname ssPts (setq n (1- n))))
							(setq en (entget e))
						)
          (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
        )
      )
      (mapcar 'last (sortpts1 lst KEY FUZZ))
    )
    ((Listp ssPts)
      (cond
        ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
        ((= (type (car ssPts)) 'ENAME)
          (foreach e ssPts
            (if (setq en (entget e))
              (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
            )
          )
          (mapcar 'last (sortpts1 lst KEY FUZZ))
        )
        (T
          (cond ((equal key "X") (vl-sort ssPts '>))
						(T (vl-sort ssPts '<))
          )
        )
      )
    )
  )
)

;;;name:BF-pickset-ssgetcrossline
;;;desc:取得与线相交的选择集
;;;arg:ent:线-图元名
;;;arg:filter:过滤列表
;;;return:选择集
;;;example:(BF-pickset-ssgetcrossline (car (entsel)) nil)
(defun BF-pickset-ssgetcrossline (ent filter / )
  (if filter
		(ssget "f" (BF-ent-getdxf ent '(10 11))  filter)
		(ssget "f" (BF-ent-getdxf ent '(10 11)))
	)
)

;;;name:BF-pickset->list
;;;desc:选择集->图元列表
;;;arg:SS:选择集
;;;return:图元列表
;;;example:(BF-pickset->list (ssget))
(defun BF-pickset->list (SS)
  (vl-remove-if-not 'BF-enamep (mapcar 'cadr (ssnamex SS))))

;;;name:BF-pickset->vlalist
;;;desc:选择集转为Vla列表
;;;arg:SS:选择集
;;;return:Vla列表
;;;example:(BF-pickset->vlalist (ssget))
(defun BF-pickset->vlalist (ss)
	(mapcar 'vlax-ename->vla-object (BF-pickset->LIST ss))
)

;;;name:BF-pickset->Array
;;;desc:选择集->数组
;;;arg:SS:选择集
;;;return:数组
;;;example:(BF-pickset->Array (ssget))
(defun BF-pickset->Array (ss)
	(BF-vla-List->Array (BF-pickset->vlalist ss) 9)
)

;;;name:BF-pickset-Sub
;;;desc:选择集相减 By 自贡黄明儒2012.8.23
;;;arg:SS1:选择集1
;;;arg:SS2:选择集2
;;;return:选择集 or nil
;;;example:(BF-pickset-Sub (setq	ss1 (ssget)) (setq ss2 (ssget)))
(defun BF-pickset-Sub	(SS1 SS2 / ENAME SS SSTEMP)
  (cond
		((and (equal (type ss1) 'PICKSET)			 (equal (type ss2) 'PICKSET)		 )
			(cond
				((equal (sslength ss1) (sslength ss2))
					(vl-cmdf "_.select" ss1 "")
					(setq ss (ssget "p"))
					(vl-cmdf "_.select" ss2 "")
					(setq ssTemp (ssget "p"))
					(repeat	(sslength ssTemp)
						(Setq ENAME (SsName ssTemp 0))
						(SsDel ENAME ssTemp)
						(if (ssmemb ENAME ss)
							(SsDel ENAME SS)
						)
					)
					(if (equal (sslength ss) 0)
						nil
						ss
					)
				)
				(T
					(command "._Select" ss1 "_Remove" ss2 "")
					(ssget "_P")
				)
			)

		)
		((and (equal (type ss1) 'PICKSET)
			 (not (equal (type ss2) 'PICKSET))
		 )
			ss1
		)
		(T nil)
  )
)

(defun BF-entlist->pickset (entlst / ss)
	(setq ss (ssadd))
	(foreach i entlst
		(ssadd i ss)
	)
	ss
)