- ;选择集与对象名表互转
- (defun cx-ss2en
- (ss / enlst)
- (cond
- ((= (type ss) 'PICKSET)
- (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
- )
- ((= (type ss) 'LIST)
- (setq enlst (ssadd))
- (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
- )
- ((='ename(type ss))
- (ssadd ss)
- )
- )
- )
- ;货物分两组(样品 库存)
- (defun lst->2lst(lst / lst1 lst2)
- (setq lst1 '() lst2 '())
- (foreach a lst
- (if (member a lst2)
- (setq lst1 (cons a lst1))
- (setq lst2 (cons a lst2))
- )
- )
- (cons (reverse lst2) (reverse lst1))
- )
- ;检查重叠块
- (defun c:chk_blocks (/ ss pt s1 dxf2 dxf41 dxf50 ss1 i)
- (setq ss (ssget '((0 . "insert")))
- i 0
- )
- (if (and ss (> (sslength ss) 2))
- (progn
- (setq entlst (cx-ss2en ss)
- ptlst (mapcar '(lambda(x) (assoc 10(entget x))) entlst)
- 2ptlst (lst->2lst ptlst)
- )
- (if (cdr 2ptlst)
- (progn
- ;(setq pt (getpoint "引出点:"))
- (foreach x (cdr 2ptlst)
- ;(entmake (list '(0 . "line") '(8 . "0-辅助层tem") (cons 62 1) x (cons 11 pt)))
- (repeat (setq k (length (cdr 2ptlst)))
- (if (and (setq e (ssname ss (setq k (1- k ))))
- (setq en (entget e))
- )
- (progn
-
- (if (member x en)
- (entdel e)
- ;(setq en (cons x en))
- )
- )
- )
- )
-
-
- )
- )
- (alert "报告老大,没有找到重叠块!")
- )
- )
- (alert "老大,这么简单的问题自己解决!")
- )
- (princ)
- )
- ;;156.1 [功能] 删除重叠对象(overkill)
- ;;不知谁写的,太好了.
- (DEFUN HH:delBLOCKs (ss / E EN K LIST1 S9 XY)
- (repeat (setq k (sslength ss))
- (if (and (setq e (ssname ss (setq k (1- k ))))
- (setq en (entget e))
- )
- (progn
- (setq xy (cdr en))
- (IF (SETQ S9 (ASSOC 5 XY))
- (SETQ XY (subst '(5 . "ASD") S9 XY))
- )
- (if (member xy list1)
- (entdel e)
- (setq list1 (cons xy list1))
- )
- )
- )
- )
- )
|