TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: jaydee on October 17, 2013, 03:04:10 AM
-
Hi.
Just wondering is this been done before or would it be a big challenge.
Basically i was given some existing schematic drawings with someone using multi-colors highlighter highlighting various part of drawing indicating stages of works or which piece of equipment provided by which trades, and i need to duplicate that in cad.
has anyone got a bounding box routine that extend about 2mm and following the profile of selected objects, rather than just a single square bounding box of all objects.
example: 2 blocks connected by a L shape lines/polyline and *text with leader arrow pointing to the blocks.
See attached sample drawing
thankyou
-
Search for something called shrinkwrap or outline or boundary of object. E.g.:
- http://www.theswamp.org/index.php?topic=10371.0
- http://www.cadtutor.net/forum/showthread.php?23056-Bounding-box-for-all-objects
- http://www.lee-mac.com/advpolyoutline.html
Then you can get another routine to offset that by a distance of your choosing. (e.g. http://www.cadtutor.net/forum/showthread.php?66522-Offset-Polyline-Help )
Then do a solid-fill hatch of the resulting boundary to make the "highlight".
-
This seems really handy, did you have any luck jaydee?
-
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)
)
-
Hi.
Im still reading up those good links provided by Irneb and hopefully can make something out of it.
The example by stefan seems promising, as i dont expect a perfect consistent outline offset of all entities, but close enough will do. some enitity like leaders might require exploding then offset.
Thankyou