Move Blocks vertically by using lisp
Do you want the group of them always vertically centered on the original position as they are in the drawing? In your example, both are moved, but if there are an odd number of them, do you want one left where they all start, and others moved up and down around it? Or is that just the way the drawing is, and a routine could leave one in place and move all the rest in the same direction?
Does it matter what order they're stacked in? Can that be random, or should it be determined by the value in one or another of the Attributes, or maybe by drawing order, or ... ?
Are they always Blocks of the same size in the vertical direction, so that the amount of movement can be built into a routine, or might they sometimes be other sizes, so that the amount of movement needs to be calculated? If so, would they always all be the same size as each other?
Kent Cooper, AIA 
[That's an explanation of where it's coming from, but it doesn't answer my questions.]
Kent Cooper, AIA
Accepted solution
OK, try this.
Command is SHIFTBLOCK and it will stack blocks which have the SAME insertion point. So it will currently not solve overlapping blocks with different insertion points.
(defun c:ShiftBlock (/ GetBlockReferences GetBlockInsertions SB_UsedPointList SB_BlockDef SB_BlockInsertion SB_BLOCKSFOUND SB_Entity SB_Fuzz SB_Heigth SB_Object SB_Point1 SB_Point2)
(defun GetBlockReferences (GBR_BlockObject)
(if
(and
(= (type GBR_BlockObject) 'VLA-OBJECT)
(= (vla-get-ObjectName GBR_BlockObject) "AcDbBlockTableRecord")
)
(vl-remove-if
'not
(mapcar
'vlax-ename->vla-object
(mapcar
'cdr
(vl-remove-if-not
'(lambda (GBR_Item) (= (car GBR_Item) 331))
(entget (vlax-vla-object->ename GBR_BlockObject))
)
)
)
)
)
)
(defun GetBlockInsertions (GBI_BlockName / GBI_BlockName GBI_Return)
(if
(= (type GBI_BlockName) 'STR)
(progn
(setq GBI_BlockName (strcase GBI_BlockName))
(vlax-for GBI_Object (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))))
(if
(and
(= (vla-get-ObjectName GBI_Object) "AcDbBlockReference")
(= (strcase (vla-get-EffectiveName GBI_Object)) GBI_BlockName)
)
(setq GBI_Return (cons GBI_Object GBI_Return))
)
)
)
)
GBI_Return
)
(if
(and
(not (initget "Name"))
(setq SB_Entity (entsel "\nSelect object [Name]: "))
(or
(and
(= SB_Entity "Name")
(setq SB_BlockName (getstring T "\nBlockname: "))
(/= SB_BlockName "")
(not (vl-catch-all-error-p (setq SB_BlockDef (vl-catch-all-apply 'vla-item (list (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) SB_BlockName)))))
)
(and
(/= SB_Entity "Name")
(= (vla-get-ObjectName (setq SB_Object (vlax-ename->vla-object (car SB_Entity)))) "AcDbBlockReference")
(not (vl-catch-all-error-p (setq SB_BlockDef (vl-catch-all-apply 'vla-item (list (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-EffectiveName SB_Object))))))
)
)
(= (vla-get-IsLayout SB_BlockDef) :vlax-false)
(= (vla-get-IsXref SB_BlockDef) :vlax-false)
(or
(and
(= (vla-get-IsDynamicBlock SB_BlockDef) :vlax-false)
(setq SB_BlocksFound (GetBlockReferences SB_BlockDef))
)
(and
(= (vla-get-IsDynamicBlock SB_BlockDef) :vlax-true)
(setq SB_BlocksFound (GetBlockInsertions (vla-get-Name SB_BlockDef)))
)
)
)
(progn
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq SB_Fuzz 1e-3)
(foreach SB_Block SB_BlocksFound
(if
(not SB_Heigth)
(progn
(vla-GetBoundingBox SB_Block 'SB_Point1 'SB_Point2)
(setq SB_Heigth
(-
(nth 1 (vlax-safearray->list SB_Point2))
(nth 1 (vlax-safearray->list SB_Point1))
)
)
)
)
(setq SB_BlockInsertion (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint SB_Block))))
(if
(vl-remove-if-not '(lambda (SB_CheckPoint) (equal SB_CheckPoint SB_BlockInsertion SB_Fuzz)) SB_UsedPointList)
(progn
(while
(vl-remove-if-not '(lambda (SB_CheckPoint) (equal SB_CheckPoint SB_BlockInsertion SB_Fuzz)) SB_UsedPointList)
(setq SB_BlockInsertion (list (nth 0 SB_BlockInsertion) (+ (nth 1 SB_BlockInsertion) SB_Heigth) (nth 2 SB_BlockInsertion)))
)
(vla-put-InsertionPoint SB_Block (vlax-3d-point SB_BlockInsertion))
)
)
(setq SB_UsedPointList (cons SB_BlockInsertion SB_UsedPointList))
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(princ "\n ** No block selected or block name doesn't exist!")
)
(princ)
)
@Anonymous wrote:
.... Some of the Blocks are not overlapping at the Intersection Point. Could you please help me is there any possibility to clear the blocks overlapping regardless of intersection point and Block name also.
....
Well, it's been a while, but since this thread has been revived.... Here's a routine that will do that. It accepts Blocks of any name(s), and their insertion points are irrelevant [it uses their bounding boxes]. It leaves whatever turns out to be the first in the selection set where it was, and moves all others vertically, leaving each one where it is in the X direction and putting the bottom of its extents 1 drawing unit higher than the top of the extents of the previous Block -- EDIT that number if 1 drawing unit is not desired [for example, zero to have them touching if they overlap in the X direction]. Depending on the positional relationship of the selected Blocks, that can sometimes mean that a given Block will be moved downward instead of upward. Minimally tested.
(defun C:SBY (/ ss n blk minpt maxpt LL UR); = Stack Blocks in Y direction
(if (setq ss (ssget '((0 . "INSERT"))))
(repeat (setq n (sslength ss))
(setq blk (ssname ss (setq n (1- n))))
(vla-getboundingbox (vlax-ename->vla-object blk) 'minpt 'maxpt)
(setq LL (vlax-safearray->list minpt))
(if refY
(progn ; then
(command "_.move" blk ""
"_none" LL
"_none" (list (car LL) (+ refY 1)); separate vertically by 1 d.u.<--EDIT as desired
); command
(vla-getboundingbox (vlax-ename->vla-object blk) 'minpt 'maxpt)
(setq refY (cadr (vlax-safearray->list maxpt))); move refY up
); progn
(setq refY (cadr (vlax-safearray->list maxpt))); else
); if
); repeat
); if
(princ)
); defun
(vl-load-com); if needed
Kent Cooper, AIA
@kheck6VR8C wrote:
Is it possible to have it where you can select multiple blocks and have it put into a list with different insertion points?
That seems a very different question from the topic of this thread. Does it deserve a new one? And if you start a new one, post an example of the format of the list you would want. Also, would that be simply reported as a list to the User in the command line? Or drawn into the drawing somehow? If so, as multiple Text objects? One Mtext object? A Table? Or sent to an external file? If so, a plain text file? A spreadsheet file? Etc., etc.
Kent Cooper, AIA
@kheck6VR8C wrote:
It's essentially the same topic but the question is, can you have them align vertically on top of each other instead of having them not be stacked vertically? You mentioned it doesn't take into account the insertion point but the boundary of the block so I was just curious if it could be stacked based upon the insertion point.
Do I understand correctly that by "list" in your previous Message you meant the word in this Message -- "stack" -- in terms of position in the drawing? [The word "list" has a specific meaning in AutoLisp terminology, quite different from that, which is where my brain went.]
And am I correct that "stacked based upon the insertion point" means with their insertion points would be vertically aligned, regardless of where those fall in relation to each Block's drawn contents?
Kent Cooper, AIA
Try this [again, minimally tested]:
(defun C:SBYI (/ ss n blk minpt maxpt LL UR insX refY)
; = Stack Blocks in Y direction -- Insertion points aligned
(if (setq ss (ssget '((0 . "INSERT"))))
(repeat (setq n (sslength ss))
(setq blk (ssname ss (setq n (1- n))))
(vla-getboundingbox (vlax-ename->vla-object blk) 'minpt 'maxpt)
(setq LL (vlax-safearray->list minpt))
(if insX
(progn ; then [subsequent one(s)]
(command "_.move" blk ""
"_none" (list (cadr (assoc 10 (entget blk))) (cadr LL))
"_none" (list insX (+ refY 1)); separate vertically by 1 drawing unit<--EDIT as desired
); command
(vla-getboundingbox (vlax-ename->vla-object blk) 'minpt 'maxpt)
(setq refY (cadr (vlax-safearray->list maxpt))); move refY up
); progn
(setq ; else [first one]
insX (cadr (assoc 10 (entget blk)))
refY (cadr (vlax-safearray->list maxpt))
); setq
); if
); repeat
); if
(princ)
); defun
(vl-load-com); if needed
Kent Cooper, AIA