(defun c:tt (/ al-selectatpoint al-selectonscreen box e ebox i inobj lst maxpt minpt ss)
(vl-load-com)
(defun ebox (e / pa pb)
(vla-GetBoundingBox e 'pa 'pb )
(setq pa (trans (vlax-safearray->list pa) 0 1)
pb (trans (vlax-safearray->list pb) 0 1)
)
(list pa pb)
)
(defun al-selectatpoint(opstr / util)
(vl-load-com)
(setq util (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-getentity (list util 'obj 'ip opstr)))
nil
(progn
;(vla-Highlight obj 1)
obj
)
)
)
(defun al-selectonscreen(lst / dxflst filter_code filter_value newset ssets thisdrawing)
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
(setq ssets (vla-get-selectionsets thisdrawing))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list ssets "SS1")))
(setq newSet (vla-add ssets "SS1"))
(progn
(vla-delete (vla-item ssets "SS1"))
(setq newSet (vla-add ssets "SS1"))
)
)
(setq dxflst (list (mapcar 'car lst) (mapcar 'cdr lst)))
(setq filter_code (vlax-make-safearray vlax-vbinteger (cons 0 (- (length (car dxflst)) 1))))
(setq filter_value (vlax-make-safearray vlax-vbvariant (cons 0 (- (length (cadr dxflst)) 1))))
(vlax-safearray-fill filter_code (car dxflst))
(vlax-safearray-fill filter_value (cadr dxflst))
(vla-selectOnScreen newSet filter_code filter_value)
newSet
)
(if (setq inobj (al-selectatpoint "\n请选择需要添加外宽的块:"))
(progn
(setq ss (al-selectonscreen (list '(0 . "INSERT") (cons 2 (vla-get-Name inobj)))))
(vlax-for item ss
(setq box (ebox item) minpt (car box) maxpt (cadr box) lst (list minpt (list (car minpt) (cadr maxpt)) maxpt (list (car maxpt) (cadr minpt))))
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) '(70 . 1)) (mapcar '(lambda (pt) (cons 10 pt)) lst)))
)
)
)
(princ)
)