Jump to content

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


PipelinerUSA
 Share

Recommended Posts

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.

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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 by ronjonp
  • Like 1
Link to comment
Share on other sites

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 by PipelinerUSA
typos
Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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 by ronjonp
  • Thanks 1
Link to comment
Share on other sites

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

 

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...