- (defun vxs (e / i v lst)
- (setq i 0)
- (while
- (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
- (setq lst (cons v lst))
- )
- (reverse lst))
- ;选择集与对象名表互转
- (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_poly (/ ss pt s1 dxf2 dxf41 dxf50 ss1 i)
- (setq ss (ssget '((0 . "*polyline")))
- i 0
- )
- (if (and ss (> (sslength ss) 2))
- (progn
- (setq entlst (cx-ss2en ss)
- ptlst (mapcar '(lambda(x) (vxs 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 (equal x (vxs e))
- (entdel e)
- ;(setq en (cons x en))
- )
- )
- )
- )
-
-
- )
- )
- (alert "报告老大,没有找到重叠块!")
- )
- )
- (alert "老大,这么简单的问题自己解决!")
- )
- (princ)
- )
|