Label every single block in a drawing with text of it's block name, centered on the face of the block

[PipelinerUSA]

I have existing drawings with hundreds of blocks.  The blocks are simple boxes (to represent antennas on towers) and they have no attributes, just a block name.  I want to automatically place the block name as a text label centered on the face of every box, and matching the same rotation as the block.

I tried using the "bn" LISP routine found in this post on the Autodesk forum, but it requires me to go one block at a time and select every single text insertion point.

Looking to figure out some kind of solution to batch label every single block in one go.

[ronjonp]

Post a sample drawing.

[mhupp]

What I created about a Year ago. had to update a bit to get the rotation of the block.

 

;;----------------------------------------------------------------------------;;
;; LABLE BLOCKS BY NAME MIDPOINT OF BOUNDINB BOX
(defun C:BLKNAME (/ SS e Name ang LL UR MPT)
  (if (setq SS (ssget '((0 . "INSERT"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq Name (cdr (assoc 2 (entget e))))
      (setq ang (cdr (assoc 50 (entget e))))
      (vla-getboundingbox (vlax-ename->vla-object e) 'minpt 'maxpt)
      (setq LL (vlax-safearray->list minpt)
            UR (vlax-safearray->list maxpt)
      )
      (setq MPT (polar LL (angle LL UR) (/ (distance LL UR) 2)))
      (entmake (list (cons 0 "TEXT")
                     (cons 10 MPT)
                     (cons 11 MPT)
                     (cons 40 (getvar 'textsize))
                     (cons 50 ang)
                     (cons 1  name)
                     (cons 71 0) 
                     (cons 72 1) 
                     (cons 73 2)
               )
      )
      
    )
    (prompt "\nNo Blocks Selected")
  )
  (princ)
)

 

[ronjonp]

I was thinking something like this to modify the block definition ( assuming we're dealing with rectangles ).

(defun c:foo (/ d f l ll p tx ur)
  ;; RJP » 2022-01-21 Adds text of blockname to block definition
  (setq l "BlockNameText")
  (vla-add (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object)))) l)
  (vlax-for b (vla-get-blocks d)
    (cond ((= 0 (vlax-get b 'isxref) (vlax-get b 'islayout))
	   (setq f nil)
	   (vlax-for o b

	     (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'll 'ur)))
	       (princ (strcat "\nBad JuJu in block: " (vla-get-name b)))
	       (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
	     )

	     (or f (setq f (= l (vla-get-layer o))))
	   )
	   (cond ((and (null f)
		       ll
		       ur
		       (setq tx	(vla-addtext
				  b
				  (vla-get-name b)
				  (vlax-3d-point
				    (setq p (append (mapcar '/ (mapcar '+ ll ur) '(2 2))
						    (list (max (last ll) (last ur)))
					    )
				    )
				  )
				  0.05
				)
		       )
		  )
		  (vla-put-alignment tx 10)
		  (vlax-put tx 'textalignmentpoint p)
		  ;; (vla-put-height tx (/ (abs (apply '- (mapcar 'cadr (list ll ur)))) 4))
		  (vla-put-layer tx l)
		 )
	   )
	  )
    )
  )
  (vla-regen d acallviewports)
  (princ)
)

 

Edited January 21, 2022 by ronjonp

[PipelinerUSA]

17 hours ago, ronjonp said:

Post a sample drawing.

I have attached a sample drawing.  I manually placed text labels on 3 of the blocks to illustrate what I am trying to do for all of them. 

The LISP program posted by mhupp is nice but the location of the labels are not consistent.  After I ran it, some of the labels are offset floating in space while some are correctly centered on the boxes.

The program you posted works great, and having the text on its own layer is great, but the text size varies.

Also, the people who view these view them in 3d realistic or shaded style, so having the labels on the top center face of the blocks is better than it being at the block centroid.

I am currently playing around with modifying your code, but if you have time and can help again its always much appreciated! 

sample_dwg_label_blocks.dwg

Edited January 21, 2022 by PipelinerUSA
typos

[ronjonp]

@PipelinerUSA The code above will give you the attached results.

sample_dwg_label_blocks - RJP.dwg

[PipelinerUSA]

29 minutes ago, ronjonp said:

@PipelinerUSA The code above will give you the attached results.

sample_dwg_label_blocks - RJP.dwg 104.72 kB · 0 downloads

Thanks! That works awesome.  Which part of the LISP code would need to be changed to place the labels on the top/uppermost Z-value of the block versus the centroid where it places them currently?

[ronjonp]

14 minutes ago, PipelinerUSA said:

Thanks! That works awesome.  Which part of the LISP code would need to be changed to place the labels on the top/uppermost Z-value of the block versus the centroid where it places them currently?

Code updated above.

 

sample_dwg_label_blocks - RJP.dwg

[PipelinerUSA]

1 hour ago, ronjonp said:

Code updated above.

 

sample_dwg_label_blocks - RJP.dwg 103.4 kB · 0 downloads

; error: bad argument type: numberp: nil

 

I get this error when I try to run the updated LISP 

[ronjonp]

Post the drawing you're using.

[PipelinerUSA]

57 minutes ago, ronjonp said:

Post the drawing you're using.

I am getting the same error on many drawings I have tried on.  Here is one attached:

856922.dwg

[ronjonp]

Updated above .. null extents in some of those blocks.

[PipelinerUSA]

8 minutes ago, ronjonp said:

Updated above .. null extents in some of those blocks.

Wow, works great!  Is it possible to change the Z location of the labels from current Z to current Z +0.01 so the text doesn't get skewed by shading when viewing in realistic 3d mode

[mhupp]

Any idea whats going on with my lisp @ronjonp ?

The bounding box is right something to do with computing the wrong angle? Is the UCS not world?

or is it object snapping?

[ronjonp]

1 hour ago, PipelinerUSA said:

Wow, works great!  Is it possible to change the Z location of the labels from current Z to current Z +0.01 so the text doesn't get skewed by shading when viewing in realistic 3d mode

Change this:

(list (max (last ll) (last ur)))

To this:

(list (+ 0.01 (max (last ll) (last ur))))

 

Edited January 21, 2022 by ronjonp

[ronjonp]

1 hour ago, mhupp said:

Any idea whats going on with my lisp @ronjonp ?

The bounding box is right something to do with computing the wrong angle? Is the UCS not world?

or is it object snapping?

It appears to be the polar function, this works:

(setq mpt (mapcar '/ (mapcar '+ ll ur) '(2 2 2)))