Apppologise, feel like i ask to much lately in this forum.
I want to update a block trim lisp from MelFranks. Mels code works a treat in most cases, except it does not trim properly when attributes located outside the block entities, which from my understanding is that the way this boundingbox calculated is to include attributes as the extend of the block.
And then i read about this code from HighflyingBird link below
http://www.theswamp.org/index.php?topic=39013.new#newI spend a night trying to figure out how to merge Mel's and HighflyingBird's codes so it could trim blocks with attributes (but exclude the attributes from boundingbox). My knowledge is limited and heading no where with these code.
If anyone able to help me to modify these codes so it could trim *LINE,ARC,CIRCLE over any blocks with or without attributes
Make sure to delete these code from HB to get the boundingbox of block entities only
(if (= (cdr (assoc 66 dxf)) 1)
(setq BoxPts (AttBox ent BoxPts))
)
Here MelFranks codes
(defun c:BLKTRIM ( / *error* trim-blk rotate-bbox sv-cmd
sv-osm acad-doc ss cnt)
(defun *error* (msg)
(vla-EndUndoMark acad-doc)
(setvar 'cmdecho sv-cmd)
(setvar 'osmode sv-osm)
)
(defun trim-blk (pts / ln-set ln-obj sp ep tmp int-lst ct)
(if(setq ln-set(ssget "cp" pts '((0 . "*LINE,ARC"))))
(progn
(setq pts(reverse(cons(car pts)(reverse pts))))
(repeat(setq ct(sslength ln-set))
(setq ln-obj (vlax-ename->vla-object
(ssname ln-set
(setq ct(1- ct))
)
)
sp (vlax-curve-getStartPoint ln-obj)
ep (vlax-curve-getEndPoint ln-obj)
tmp pts
int-lst '()
)
(while(>(length tmp)1)
(if(setq int(inters sp ep(car tmp)(cadr tmp)nil))
(if(inters sp int (car tmp)(cadr tmp))
(setq int-lst(cons int int-lst))
)
)
(setq tmp(cdr tmp))
)
(if(=(length int-lst)2)
(vl-cmdf "_.break"
(list
(vlax-vla-object->ename ln-obj)
(car int-lst)
)
(cadr int-lst)
)
)
)
)
)
)
(defun rotate-bbox (blk-obj / mspace blk-rot blk-pt blk-bbox
p1 p2 p3 p4 x tmp)
(setq mspace (vla-get-modelspace acad-doc)
blk-rot (vlax-get-property blk-obj 'Rotation)
blk-pt (vlax-get-property blk-obj 'InsertionPoint)
)
(vlax-put-property blk-obj 'Rotation 0.0)
(setq blk-bbox (vla-getBoundingBox blk-obj 'p1 'p3)
p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3)
p1 (list(car p1)(cadr p1))
p3 (list(car p3)(cadr p3))
p2 (list(car p1)(cadr p3))
p4 (list(car p3)(cadr p1))
)
(vlax-put-property blk-obj 'Rotation blk-rot)
(foreach x '(p1 p2 p3 p4)
(vla-rotate
(vla-addpoint mspace(vlax-3d-point(eval x)))
blk-pt
blk-rot
)
(set x(vlax-ename->vla-object(entlast)))
)
(foreach x '(p1 p2 p3 p4)
(setq tmp(eval x))
(set x
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property(eval x)'Coordinates)
)
)
)
(vla-delete tmp)
)
(list p1 p2 p3 p4)
)
(setq sv-cmd (getvar "cmdecho")
sv-osm (getvar "osmode")
acad-doc (vla-get-activedocument
(vlax-get-Acad-Object)
)
)
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(vla-StartUndoMark acad-doc)
(if(setq ss(ssget '((0 . "INSERT"))))
(repeat(setq cnt(sslength ss))
(trim-blk
(rotate-bbox
(vlax-ename->vla-object
(ssname ss
(setq cnt(1- cnt))
)
)
)
)
)
)
(vla-EndUndoMark acad-doc)
(setvar 'cmdecho sv-cmd)
(setvar 'osmode sv-osm)
(princ)
)
Thankyou in advance verymuch appriciated