Hi jaydee
I've thinking a lot if it is opportune to post my solution or not, because it is not flawless. It works on your sample... kind of, but there are some problems with Mtexts, open polylines, leaders and probably more. A future improvement can be done, treating each object type separately. No promises, but if I have time, maybe I will improve it.
Here is my poorly attempt.
(defun c:test ( / *error* crt_space off_dist ss i e p1 p2 pl l reg border hatch)
(or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
(vla-startundomark acDoc)
(setq crt_space (if (= 1 (getvar 'cvport))
(vla-get-paperspace acDoc)
(vla-get-modelspace acDoc)
)
)
(defun *error* (msg)
(and msg
(not (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*QUIT*"))
(princ (strcat "\nError:" msg))
)
(vla-endundomark acDoc)
(princ)
)
(if
(and
(setq ss (ssget))
(setq off_dist (getdist "\nOffset distance: "))
)
(progn
(repeat (setq i (sslength ss))
(setq i (1- i)
e (vlax-ename->vla-object (ssname ss i))
)
(vla-GetBoundingBox e 'p1 'p2)
(setq p1 (mapcar '- (vlax-safearray->list p1) (list off_dist off_dist))
p2 (mapcar '+ (vlax-safearray->list p2) (list off_dist off_dist))
pl (vlax-invoke
crt_space
'addlightweightpolyline
(list
(car p1) (cadr p1)
(car p2) (cadr p1)
(car p2) (cadr p2)
(car p1) (cadr p2)
)
)
)
(vla-put-closed pl :vlax-true)
(setq l (cons (car (vlax-invoke crt_space 'AddRegion (list pl))) l))
(vla-delete pl)
)
(setq reg (car l))
(foreach x (cdr l)
(vlax-invoke reg 'boolean acUnion x)
)
(setq border (vlax-invoke reg 'explode))
(vla-delete reg)
(if (vl-every '(lambda (x) (eq (vla-get-ObjectName x) "AcDbRegion")) border)
(setq border (mapcar '(lambda (x / a)
(setq a (vlax-invoke x 'explode))
(vla-delete x)
a
)
border
)
)
(setq border (list border))
)
(setq hatch (vla-AddHatch crt_space acHatchPatternTypePredefined "SOLID" :vlax-false AcHatchObject))
(foreach x border
(vlax-Invoke hatch 'AppendOuterLoop x)
(foreach y x
(vla-delete y)
)
)
(vla-put-color hatch acRed)
(vlax-invoke
(vlax-invoke
(vla-getextensiondictionary crt_space)
'GetObject
"ACAD_SORTENTS"
)
'movetobottom
(list hatch)
)
)
)
(vla-endundomark acDoc)
(princ)
)