Requesting change in code to generate block names as text for multiple blocks

Requesting change in code to generate block names as text for multiple blocks

Anonymous
Not applicable
1,311 Views
10 Replies
Message 1 of 11

Requesting change in code to generate block names as text for multiple blocks

Anonymous
Not applicable

Dear Experts,

 

I need a small change in below lisp code. Below lisp code can generate text (as block name) for one block only. The requirement is to generate texts (block names) for multiple selected blocks.

(setq bn_txt nil)
(defun C:bn( / pt1 blname)
(if (null bn_txt)
(progn
(setvar "TEXTSIZE" (getdist "\Height of text label (uses default 
style): "))
(setq bn_txt "sizeset")
) ; end progn
) ; end if
(princ "\nAdd block name to drawing.")
(setq blname (cdr (assoc 2 (entget (car (entsel"\nSelect Block:"))))))
(setq pt1 (getpoint"\nSelect centre point for block title:"))
(command "text" "c" pt1 "" "" blname)
)
(princ "\nType BN to execute.")
[/code]

 

Thanks in advance.

0 Likes
Accepted solutions (2)
1,312 Views
10 Replies
Replies (10)
Message 2 of 11

pbejse
Mentor
Mentor

 

(setq bn_txt nil)
(defun C:bn (/ pt1 blocks i pt1 blocknames hght)
  (if (null bn_txt)
    (progn
      (setvar "TEXTSIZE"
	      (getdist "\Height of text label (uses default style): ")
      )
      (setq bn_txt "sizeset")
    )					; end progn
  )					; end if
  (princ "\nAdd block name to drawing.")
  (if
    (and
      (setq hght (getvar "TEXTSIZE") blocks (ssget '((0 . "INSERT"))))
      (setq pt1 (getpoint "\nSelect centre point for block title:")))
    	(progn
	    	(repeat (setq i (sslength blocks))	  	
		  	(setq blocknames (cons
					   (getpropertyvalue (ssname blocks (setq i (1- i)))
					     	"BlockTableRecord/Name") blocknames))
		  )
	  (foreach itm (acad_strlsort  blocknames)
	    (entmakex (list (cons 0 "TEXT")
                  (cons 10  pt1)
                  (cons 40 hght)
                  (cons 1  itm)))
	    (setq pt1 (polar pt1 (* pi 1.5) (* 1.333 hght)))
	    )
	  )
    )
  (princ)
)
(princ "\nType BN to execute.")

 

HTH

 

 

0 Likes
Message 3 of 11

pbejse
Mentor
Mentor

This one will avoid duplicates

 

(setq bn_txt nil)

(defun C:bn (/ pt1 blocks i pt1 blocknames)
  (if (null bn_txt)
    (progn
      (setvar "TEXTSIZE"
	      (getdist "\Height of text label (uses default style): ")
      )
      (setq bn_txt "sizeset")
    )					; end progn
  )					; end if
  (princ "\nAdd block name to drawing.")
  (if
    (and
      (setq hght (getvar "TEXTSIZE") blocks (ssget '((0 . "INSERT"))))
      (setq pt1 (getpoint "\nSelect centre point for block title:")))
    	(progn
	    	(repeat (setq i (sslength blocks))
			(Setq bn (getpropertyvalue (ssname blocks (setq i (1- i)))
					     	"BlockTableRecord/Name"))		  
		  (if (not (member bn blocknames))
		  		(setq blocknames (cons  bn blocknames)))
		  )
	  (foreach itm (acad_strlsort  blocknames)
	    (entmakex (list (cons 0 "TEXT")
                  (cons 10  pt1)
                  (cons 40 hght)
                  (cons 1  itm)))
	    (setq pt1 (polar pt1 (* pi 1.5) (* 1.333 hght)))
	    )
	  )
    )
  (princ)
)
(princ "\nType BN to execute.") 
0 Likes
Message 4 of 11

Anonymous
Not applicable

Dear Sir,

 

Thanks for Spot reply, But the exact requirement is to place the text at respective block geometry (means text to be placed at each block insertion point).

0 Likes
Message 5 of 11

pbejse
Mentor
Mentor

@Anonymous wrote:

Dear Sir,

 

Thanks for Spot reply, But the exact requirement is to place the text at respective block geometry (means text to be placed at each block insertion point).


I knew it 😐

(setq bn_txt nil)

(defun C:bn (/ pt1 blocks i pt1 blocknames)
  (if (null bn_txt)
    (progn
      (setvar "TEXTSIZE"
	      (getdist "\Height of text label (uses default style): ")
      )
      (setq bn_txt "sizeset")
    )					; end progn
  )					; end if
  (princ "\nAdd block name to drawing.")
  (if
      (setq hght (getvar "TEXTSIZE") blocks (ssget '((0 . "INSERT"))))
	  (repeat (setq i (sslength blocks))
		(Setq bn (getpropertyvalue
			   (setq e (ssname blocks (setq i (1- i))))
					     	"BlockTableRecord/Name"))
		    (entmakex (list (cons 0 "TEXT")
	                  (assoc 10 (entget e))
	                  (cons 40 hght)
	                  (cons 1  bn)))
		    
		    )
	  )
  (princ)
)

HTH

 

 

0 Likes
Message 6 of 11

Anonymous
Not applicable

Thanks a lot Sir,

 

But when using second time this command, it's not asking for text height. only at the time of first time input only it's asking for text height and second time, we are not able to feed text height value.

0 Likes
Message 7 of 11

pbejse
Mentor
Mentor
Accepted solution

@Anonymous wrote:

Thanks a lot Sir,

 

But when using second time this command, it's not asking for text height. only at the time of first time input only it's asking for text height and second time, we are not able to feed text height value.


This is getting ridiculous @Anonymous , 

(defun C:bn (/ hght blocks i blocknames) ; end if
  (if
     (and
       (setq hght (getdist "\Height of text label  "))
       (setq blocks (ssget '((0 . "INSERT"))))
       )  
	  (repeat (setq i (sslength blocks))
		(Setq bn (getpropertyvalue
			   (setq e (ssname blocks (setq i (1- i))))
					     	"BlockTableRecord/Name"))
		    (entmakex (list (cons 0 "TEXT")
	                  (assoc 10 (entget e))
	                  (cons 40 hght)
	                  (cons 1  bn)))
		    
		    )
	  )
  (princ)
)
(princ "\nType BN to execute.")

 

 

 

 

 

0 Likes
Message 8 of 11

Anonymous
Not applicable

Excellent Sir,

 

I got, exactly what I requested you. Sorry for extending to asking one more help.

The text falling under "Standard" style everytime, even if I set to other text style. Suppose if I set to "Romans" or any other style, then also the texts are falling in Standard style only.

 

Sorry for asking one more help, Sir.

0 Likes
Message 9 of 11

pbejse
Mentor
Mentor
Accepted solution

@Anonymous wrote:

The text falling under "Standard" style everytime, even if I set to other text style. Suppose if I set to "Romans" or any other style, then also the texts are falling in Standard style only.


(defun C:bn (/ hght blocks i blocknames) ; end if
  (if
     (and
        (setvar "TEXTSIZE"
	      (setq hght (getdist "\Height of text label (uses default style): ")))
       (setq blocks (ssget '((0 . "INSERT"))))
       )  
	  (repeat (setq i (sslength blocks))
		(Setq bn (getpropertyvalue
			   (setq e (ssname blocks (setq i (1- i))))
					     	"BlockTableRecord/Name"))
		    (entmakex (list (cons 0 "TEXT")
	                  (assoc 10 (entget e))
	                  (cons 40 hght)
			  (cons 7 (getvar 'Textstyle))	    
	                  (cons 1  bn)))
		    
		    )
	  )
  (princ)
)
(princ "\nType BN to execute.")

 

=================================================================

 How NOT to request for help.

 

- I need a small change in below lisp code. Below lisp code can generate text (as block name) for one block only.

 

code posted

 

- The requirement is to generate texts (block names) for multiple selected blocks.

 

code posted

 

But the exact requirement is to place the text at respective block geometry (means text to be placed at each block insertion point)

 

code posted

 

- But when using second time this command, it's not asking for text height.

 

code posted

 

..Suppose if I set to "Romans" or any other style,

 

code posted

=====================================================================

Seriously @Anonymous  the code you posted is only 10% of what you really want.

I told you once before..

Also , please do this for us, next time, be clear on the what you're requesting for and avoid posting conflicting information.
The clearer the goal the faster you get correct results.

And me [pathetic]  believing it will be different this time around. 

sighing.gif

 

Lesson learned.

Message 10 of 11

Anonymous
Not applicable

Sir,

 

Sorry for making a confusion, without any clarity in my query. Excuse me.

0 Likes
Message 11 of 11

pbejse
Mentor
Mentor

Dont worry about it, please be clear next time.

 

0 Likes