topic Re: Move Blocks vertically by using lisp in Visual LISP, AutoLISP and General Customization Forum

Move Blocks vertically by using lisp

Anonymous — Mon, 02 Jul 2018 06:03:54 GMT

Hi All,

I need some help for moving of Blocks automatically by using Lisp. Please find the attached drawing for your reference (Before & After). I have provided only two blocks in drawing. But i have to clean so many blocks like this by manually.

At this location only two blocks are overlapping, but some times they may come around 8 also.

Could you please help anyone. If i have lisp i can save so much time for clean up.

Thank you,

Sai.

Re: Move Blocks vertically by using lisp

dbroad — Mon, 02 Jul 2018 12:55:07 GMT

;;MV = Move vertically constrained.
(defun C:MV (/ SS P1 P2) ;D. C. Broad, Jr. (select objects and pick 2 points)
  (setq SS (ssget))			;SELECT OBJECTS TO MOVE
  (setq P1 (getpoint "\nFrom point: "))
  (setq P2 (getpoint "\NTo point: "))
  (setq P2 (cons (car P1) (cdr P2)))
  (command "MOVE" SS "" "NON" P1 "NON" P2)
  (princ)
)

Re: Move Blocks vertically by using lisp

Kent1Cooper — Mon, 02 Jul 2018 13:19:43 GMT

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?

Re: Move Blocks vertically by using lisp

Anonymous — Wed, 04 Jul 2018 02:01:49 GMT

Thank you Dbroad for providing me Lisp.

But, actually I'm expecting a Lisp to move all blocks automatically without manual movement.

In my drawings the same size blocks are overlapping when I'm converting the mapinfo data to Auto CAD drawing.

After converting, the blocks which are assigned to particular object will overlap on each block at the same location.

For example, for Object 1 i will assign two codes in mapinfo and for object 2 i will assign 6 codes. when I convert the data to CAD, the blocks are overlapping in CAD. if those 2 or more.

I hope you understand my query.

Could you please help me to automate this.

Thanks in advance.

Regards,

Sai.

Re: Move Blocks vertically by using lisp

Anonymous — Wed, 04 Jul 2018 02:04:03 GMT

Hi Kent,

Thank you for your response. I explained my problem in the below.

In my drawings the same size blocks are overlapping when I'm converting the mapinfo data to Auto CAD drawing.

After converting, the blocks which are assigned to particular object will overlap on each block at the same location.

For example, for Object 1 i will assign two codes in mapinfo and for object 2 i will assign 6 codes. when I convert the data to CAD, the blocks are overlapping in CAD. if those 2 or more

Thanks in advance.

Regards,

Sai.

Re: Move Blocks vertically by using lisp

dlanorh — Wed, 04 Jul 2018 09:54:29 GMT

Any chance you can post the drawing in 2010 format?

Re: Move Blocks vertically by using lisp

Kent1Cooper — Wed, 04 Jul 2018 11:59:39 GMT

[That's an explanation of where it's coming from, but it doesn't answer my questions.]

Re: Move Blocks vertically by using lisp

Anonymous — Sun, 08 Jul 2018 22:45:33 GMT

Please Find the attached Drawing in 2010 format.

Thanks,

Sai.

Re: Move Blocks vertically by using lisp

DannyNL — Tue, 10 Jul 2018 07:38:37 GMT

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)
)

Re: Move Blocks vertically by using lisp

Anonymous — Wed, 11 Jul 2018 00:47:08 GMT

Thank you Danny...

It is a great help to me..I really appreciate your great work.

Thank you so much. The lisp saves so much of time for me.

Thanks again...

Regards,

Sai.

Re: Move Blocks vertically by using lisp

DannyNL — Wed, 11 Jul 2018 06:49:20 GMT

You're welcome & glad I could help

Re: Move Blocks vertically by using lisp

Anonymous — Fri, 13 Jul 2018 05:25:07 GMT

Hi Danny,

Good Day!

I am requesting one more help about these Blocks Overlapping. 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.

Regards,

Sai.

Re: Move Blocks vertically by using lisp

Anonymous — Tue, 21 Aug 2018 06:01:21 GMT

Hi Danny,

Could you please provide any update on the request.

Thanks for your Help....

Regards,

Sai.

Re: Move Blocks vertically by using lisp

kheck6VR8C — Mon, 06 May 2019 11:34:43 GMT

Is it possible to have it where you can select multiple blocks and have it put into a list with different insertion points?

Re: Move Blocks vertically by using lisp

Kent1Cooper — Mon, 06 May 2019 13:03:08 GMT

@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

Re: Move Blocks vertically by using lisp

Kent1Cooper — Mon, 06 May 2019 13:07:51 GMT

@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.

Re: Move Blocks vertically by using lisp

kheck6VR8C — Mon, 06 May 2019 13:20:13 GMT

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.

Re: Move Blocks vertically by using lisp

Kent1Cooper — Mon, 06 May 2019 14:16:18 GMT

@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?

Re: Move Blocks vertically by using lisp

kheck6VR8C — Mon, 06 May 2019 14:18:03 GMT

Yes, that is what I meant is "stacked" based upon insertion point. Sorry for the confusion.

Re: Move Blocks vertically by using lisp

Kent1Cooper — Mon, 06 May 2019 14:53:23 GMT

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