Insert Block at selected objects?

[tzframpton]

This has got to exist somewhere but after thirty minutes of searching I'm coming up empty. I tried Lee Mac's Point Manager program but without success.

 

What I'm wanting to do is insert a block at the geometrical center of a large selection of various blocks.

 

To be more specific, I have many different blocks that represent HVAC ceiling diffusers. These blocks range from size, shape, name, etc. and most of them are Dynamic Blocks. All of these must be labeled, in which yet another block is used. This label is the same block for each one. So if I have a drawing with 500 different ceiling diffusers, I just want to select all these blocks, click a button and the Ceiling Diffuser Tag (which is a block with three attributes) are all placed at the center. I will then go back and shift them all to the side, and edit them one by one. This just speeds up the process of manually copying them all around a drawing.

 

Anything out there that does just this? Or can Lee Mac's Point Manager program do this, chalking my unsuccessful effort up to "user error" lol? Thanks in advance!

 

-TZ

[David Bethel]

Have you searched for centroid type of routines ? Or do you want a single insert for each diffuser ?

 

What you is very doable but probably has needs for this specific use. -David

[Lee Mac]

Assuming I've understood, here is a quick example using some existing code:

;; Insert Block at Block Centres  -  Lee Mac

(defun c:insblkcen ( / *error* blk box idx ref sel spc )

   (defun *error* ( msg )
       (LM:endundo (LM:acdoc))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (LM:startundo (LM:acdoc))
   (if (and (setq blk (LM:selectifobject "\nSelect block to be inserted: " "INSERT"))
            (setq blk (LM:name->effectivename (cdr (assoc 2 (entget blk)))))
            (setq sel (LM:ssget (strcat "\nSelect blocks to insert \"" blk "\" at center: ") '(((0 . "INSERT")))))
            (setq spc (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
       )
       (repeat (setq idx (sslength sel))
           (if (setq ref (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                     box (LM:blockreferenceboundingbox ref)
               )
               (vla-insertblock spc
                   (vlax-3D-point (mapcar '/ (apply 'mapcar (cons '+ box)) '(4.0 4.0))) blk 1.0 1.0 1.0
                   (vla-get-rotation ref)
               )
           )
       )
   )
   (LM:endundo (LM:acdoc))
   (princ)
)

;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name

(defun LM:name->effectivename ( blk / rep )
   (if
       (and (wcmatch blk "`**")
           (setq rep
               (cdadr
                   (assoc -3
                       (entget
                           (cdr (assoc 330 (entget (tblobjname "block" blk))))
                          '("AcDbBlockRepBTag")
                       )
                   )
               )
           )
           (setq rep (handent (cdr (assoc 1005 rep))))
       )
       (cdr (assoc 2 (entget rep)))
       blk
   )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget arg))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)

;; Select if Object  -  Lee Mac
;; Continuously prompts the user for a selection of a specific object type

(defun LM:selectifobject ( msg typ / ent )
   (while
       (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null ent) nil)
               (   (not (wcmatch (cdr (assoc 0 (entget ent))) typ))
                   (princ "\nInvalid object selected.")
               )
           )
       )
   )
   ent
)

;; Block Reference Bounding Box  -  Lee Mac
;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block reference.
;; Excludes Text, MText & Attribute Definitions.
;; ref - [vla] Block Reference Object

(defun LM:blockreferenceboundingbox ( ref )
   (
       (lambda ( lst )
           (apply
               (function
                   (lambda ( m v )
                       (mapcar (function (lambda ( p ) (mapcar '+ (mxv m p) v))) lst)
                   )
               )
               (refgeom (vlax-vla-object->ename ref))
           )
       )
       (LM:blockdefinitionboundingbox
           (vla-item
               (vla-get-blocks (vla-get-document ref))
               (vla-get-name ref)
           )
       )
   )
)

;; Block Definition Bounding Box  -  Lee Mac
;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block definition.
;; Excludes Text, MText & Attribute Definitions.
;; def - [vla] Block Definition Object

(defun LM:blockdefinitionboundingbox ( def / llp lst urp )
   (vlax-for obj def
       (cond
           (   (= :vlax-false (vla-get-visible obj)))
           (   (= "AcDbBlockReference" (vla-get-objectname obj))
               (setq lst (append lst (LM:blockreferenceboundingbox obj)))
           )
           (   (and (not (wcmatch (vla-get-objectname obj) "AcDbAttributeDefinition,AcDb*Text"))
                    (vlax-method-applicable-p obj 'getboundingbox)
                    (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
               )
               (setq lst (vl-list* (vlax-safearray->list llp) (vlax-safearray->list urp) lst))
           )
       )
   )
   (LM:points->boundingbox lst)
)

;; Points to Bounding Box  -  Lee Mac
;; Returns the rectangular extents of a supplied point list

(defun LM:points->boundingbox ( lst )
   (   (lambda ( l )
           (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) l)) a))
              '(
                   (caar   cadar)
                   (caadr  cadar)
                   (caadr cadadr)
                   (caar  cadadr)
               )
           )
       )
       (mapcar '(lambda ( f ) (apply 'mapcar (cons f lst))) '(min max))
   )
)

;; RefGeom (gile)
;; Returns a list which first item is a 3x3 transformation matrix (rotation, scales, normal)
;; and second item the object insertion point in its parent (xref, block or space)
;; Argument : an ename

(defun refgeom ( ent / ang ang mat ocs )
   (setq enx (entget ent)
         ang (cdr (assoc 050 enx))
         ocs (cdr (assoc 210 enx))
   )
   (list
       (setq mat
           (mxm
               (mapcar '(lambda ( v ) (trans v 0 ocs t))
                  '(
                       (1.0 0.0 0.0)
                       (0.0 1.0 0.0)
                       (0.0 0.0 1.0)
                   )
               )
               (mxm
                   (list
                       (list (cos ang) (- (sin ang)) 0.0)
                       (list (sin ang) (cos ang)     0.0)
                      '(0.0 0.0 1.0)
                   )
                   (list
                       (list (cdr (assoc 41 enx)) 0.0 0.0)
                       (list 0.0 (cdr (assoc 42 enx)) 0.0)
                       (list 0.0 0.0 (cdr (assoc 43 enx)))
                   )
               )
           )
       )
       (mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
           (mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
       )
   )
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
   (apply 'mapcar (cons 'list m))
)

;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
   ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
   (LM:endundo doc)
   (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
   (while (= 8 (logand 8 (getvar 'undoctl)))
       (vla-endundomark doc)
   )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)

(vl-load-com) (princ)

 

Edited July 21, 2021 by Lee Mac

[tzframpton]

Assuming I've understood, here is a quick example using some existing code:

[color=GREEN];; Insert Block at Block Centres  -  Lee Mac[/color]

([color=BLUE]defun[/color] c:insblkcen 

...snip...

Perfecto, Lee!

 

I can use this program exactly as you have written it. If you would ever be interested in developing this program more for others to use, a few things I would suggest would be the current entity properties of the selected block (Color, Linetype, Layer, etc), Scale and Rotation.

 

Again, I can certainly use the program exactly as it stands since the above mentions can be achieved easily through QSelect and Properties Palette.

 

Thanks again for this one Lee!!

 

-TZ

[BIGAL]

quick example

Wow lee what would a more complex answer be like.

 

I just thought get insert points and average the x & Y, you have done so much more.

[David Bethel]

Indeed ! 1+

 

Wow lee what would a more complex answer be like.

 

I just thought get insert points and average the x & Y, you have done so much more.

[tzframpton]

Glad to see others who actually know what they're looking at was just as amazed at how many lines of code were used in my request. I'm definitely humbled if this was from scratch.

 

I've already used this program on two jobs and has saved me a ton of time. Many, many thanks again to Lee.

 

-TZ

[ReMark]

Now that Michael's Corner will no longer be a bi-monthly part of CADTutor maybe there could be a "Lee Mac's Lisp Emporium"?

[Lee Mac]

Perfecto, Lee!

 

I can use this program exactly as you have written it. If you would ever be interested in developing this program more for others to use, a few things I would suggest would be the current entity properties of the selected block (Color, Linetype, Layer, etc), Scale and Rotation.

 

Again, I can certainly use the program exactly as it stands since the above mentions can be achieved easily through QSelect and Properties Palette.

 

Thanks again for this one Lee!!

I've already used this program on two jobs and has saved me a ton of time. Many, many thanks again to Lee.

 

Excellent to hear Tannar, I'm delighted that the program is saving you time already and thank you for your gratitude.

 

Matching the properties of the block initially selected by the user is a good idea and perhaps how the user would intuitively expect the program to operate. The required modifications would not be overly difficult, and so if many others request this functionality, I may look to implement it in the future.

 

Wow lee what would a more complex answer be like.

 

I just thought get insert points and average the x & Y, you have done so much more.

Indeed ! 1+

Glad to see others who actually know what they're looking at was just as amazed at how many lines of code were used in my request. I'm definitely humbled if this was from scratch.

 

Many thanks all, I appreciate the positive feedback & compliments.

 

Admittedly, all of the supporting functions were from my library, and so it sufficed to assemble the program from the various building blocks.

 

Now that Michael's Corner will no longer be a bi-monthly part of CADTutor maybe there could be a "Lee Mac's Lisp Emporium"?

 

Haha! Nice idea ReMark - but there is already a 'Lee Mac LISP Emporium' here.

[ReMark]

Well maybe you can be an adjunct professor and CADTutor could be a satellite campus. OK...you got that covered too. How about selling exclusive "Lee Mac" merchandise? Hats, tee shirts, key chains, foam fingers, bumper stickers? You got to expand the brand man!:lol:

[EFL]

Well maybe you can be an adjunct professor and CADTutor could be a satellite campus. OK...you got that covered too. How about selling exclusive "Lee Mac" merchandise? Hats, tee shirts, key chains, foam fingers, bumper stickers? You got to expand the brand man!:lol:

 

+1 from me...

[brianfengming]

how to use this lisp?
i try to copy all and paste to note and save us .lsp file.
but, i can't excuse it

[BIGAL]

If you copied Lee's code it has BBC code in it to display color it is known to Admin that old code may have this in it, you need tor remove all the [color=BLUE] [/color]  etc from the code. Just use search replace.

 

[Lee Mac]

I've now updated my earlier post to remove the visible BBCode formatting.

[Czer]

On 7/22/2021 at 2:12 AM, Lee Mac said:

I've now updated my earlier post to remove the visible BBCode formatting.

Hi! Lee.  First of all, sorry for bringing up this thread back. Second, Thanks for your generosity in sharing your code to all of us, it helps us a lot in our AutoCAD workflow. 
I just have a question to ask. I hope this is not too much to ask from you. What if I need to Insert a Block at Block Insertion point not at the center, what will be the code to use?

Thanks in advance, and I looking forward for your answer.

[mhupp]

4 hours ago, Czer said:

I hope this is not too much to ask from you. What if I need to Insert a Block at Block Insertion point not at the center, what will be the code to use?

 

Update the first part

 

;; Insert Block at Block insertion point  -  Lee Mac
(defun c:insblkcen ( / *error* blk box idx ref sel spc )
   (defun *error* ( msg )
       (LM:endundo (LM:acdoc))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   (LM:startundo (LM:acdoc))
   (if (and (setq blk (LM:selectifobject "\nSelect block to be inserted: " "INSERT"))
            (setq blk (LM:name->effectivename (cdr (assoc 2 (entget blk)))))
            (setq sel (LM:ssget (strcat "\nSelect blocks to insert \"" blk "\" at insertion point: ") '(((0 . "INSERT")))))
            (setq spc (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
       )
       (repeat (setq idx (sslength sel))
           (if (setq ref (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
              (vla-insertblock spc
                (vla-get-insertionpoint ref)
                (vla-get-rotation ref)
              )
           )
       )
   )
   (LM:endundo (LM:acdoc))
   (princ)
)

 

[Czer]

17 hours ago, mhupp said:

 

Update the first part

 

;; Insert Block at Block insertion point  -  Lee Mac
(defun c:insblkcen ( / *error* blk box idx ref sel spc )
   (defun *error* ( msg )
       (LM:endundo (LM:acdoc))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   (LM:startundo (LM:acdoc))
   (if (and (setq blk (LM:selectifobject "\nSelect block to be inserted: " "INSERT"))
            (setq blk (LM:name->effectivename (cdr (assoc 2 (entget blk)))))
            (setq sel (LM:ssget (strcat "\nSelect blocks to insert \"" blk "\" at insertion point: ") '(((0 . "INSERT")))))
            (setq spc (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
       )
       (repeat (setq idx (sslength sel))
           (if (setq ref (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
              (vla-insertblock spc
                (vla-get-insertionpoint ref)
                (vla-get-rotation ref)
              )
           )
       )
   )
   (LM:endundo (LM:acdoc))
   (princ)
)

 

Thank you very much.

[JensiLehmanni]

Hello to everyone,

I'am currently searching for a new Workflow in GIS work with treepoints from opendata. Is there away to adapt this lisp to insert a circle as block (tree) according to the median diameter of all closed and selected polygons? I cant figure out how QGIS is exporting real circles. The Export gets very nastily shaped (+100 Points per Object) and my .dxf gets very slow.. 

Thanks in adanvance for any reply

 

Jens

[mhupp]

what you are describing sounds like 100 little polylines that make a circle. can you upload an test with a few different circles.

[JensiLehmanni]

After a night's long odysee I finaly managed to create Circles with Logarithmic Randomized Diameter/Radius based on a Utm Point, and Diameter-Attribute-Field Export from Qgis within AutoCAD. Problem solved.

 

 

QGIS Dxf Translators are not able to manage true Autocad Circle Geometry Export from Symbology (as far as I came to understand). The circleshape geometry is exported as approximation in variant depth, thus incorporating a huge volume of polydata. If merging this into a whole Urband Map, no normal Computer can compete. 

 

Unfortunately various scripts and lisps are from scratch not able to transform non centered polygons (due to QGIS Export)  into circle shapes within Autocad or approximational lisp approches f.e. Mac lee's algorithm is not able to transform multiply objects. This is necessary when its needed to transform some 100.000 treeshapes. If a solution occurs, I would still be happy to apply it since scripting from .csv export is time consuming.

 

 

P.S.: This is the .scr Format, which works for me in Englisch Programm Language

 

_.circle 407085.7034,5654306.4378 0 4  
_.circle 407003.9392,5654320.2512 0 6  
_.circle 407080.793,5654183.3462 0 5  
_.circle 407080.0534,5654190.1834 0 5  
_.circle 407137.0634,5654348.3333 0 5  
_.circle 407088.8223,5654363.7145 0 4  
_.circle 406931.8599,5654338.1042 0 4  
_.circle 407013.79,5654218.6835 0 3  
_.circle 406945.5144,5654402.9286 0 4  
_.circle 407055.611,5654334.694 0 3  
_.circle 407132.7898,5654321.4143 0 6  
_.circle 407088.224,5654315.275 0 5  
_.circle 406976.6814,5654414.9839 0 7  
_.circle 407030.5815,5654249.8335 0 5  
_.circle 407102.4161,5654353.2188 0 4  
_.circle 406892.356,5654178.0871 0 5  
_.circle 407069.4076,5654168.3424 0 4  
_.circle 407039.6829,5654293.752 0 5  
_.circle 407079.6753,5654286.0951 0 5  
_.circle 407060.4819,5654198.2803 0 7  
_.circle 406965.3617,5654275.0319 0 4  
_.circle 406930.5689,5654258.5616 0 4  
_.circle 407037.8336,5654287.8544 0 5  
_.circle 407053.0831,5654251.978 0 6  
   

Edited May 7, 2022 by JensiLehmanni