Community

Set attribute tags to blank blocks

Set attribute tags to blank blocks

pierre_costeS8GW8
Enthusiast Enthusiast
893 Views
12 Replies
Message 1 of 13

Set attribute tags to blank blocks

pierre_costeS8GW8
Enthusiast
Enthusiast
‎06-26-2023 08:05 AM

Hi everyone,

 

I have a library containing various dwg files, which themselves contain one block. All these blocks have no attributes. 

 

Is it possible to create a lisp routine that allows me to select a block and set attribute tags defined in advance in a list? (list "WEIGHT" "ELEMENT_CATEGORY" ""....).

 

The values will be written by hand but if i can avoid setting attribute tags manually it would be great.

 

Thank you for your answers or suggestion, i am aware of any ideas.

 

Have a nice day.

0 Likes
Like
Report
Accepted solutions (2)
Solution 1
Solution 2
894 Views
12 Replies
Replies (12)
Message 2 of 13

Moshe-A
Mentor
Mentor
‎06-26-2023 10:39 AM
Accepted solution

@pierre_costeS8GW8  hi,

 

check this ADDTAGS command.

 

Note:

adding attributes to a block with such command could be messy cause we need to specify the tag position, tag height and other properties. have you thought what would would happen if the block already have attributes?

what if the added attribute will overlap?  does the size will appropriate? some question have to be answer here  😀

 

for start what i did is define some constant variables for you to set:

 

line 15: (setq TAGSCL 1) ; this set the tag\text scale. if it comes small, increase this value.
line 16: (setq TAGHGT 0.25) ; this set the tag\text base height. change it if needed
line 17: (setq DATATAGS '("WEIGHT" "ELEMENT_CATEGORY")) ; define the attributes to add

 

if you select a block that already contain one of DATATAGS tag, the attributes is skipped.

attributes will be positioned from 0,0,0 and above. will it be overlapped? could be, that on you 😀

 

enjoy

Moshe

 

(vl-load-com)

(defun c:addtags (/ _gettags ; local function
		    TAGSCL TAGHGT DATATAGS adoc blocks ss ename AcDbBlkRef bname AcDbBlkTblRec hgt ypos tag AcDbAttdef ctr0 ctr1)

 (setq _gettags (lambda () (mapcar (function (lambda (AcDbAttrib) (strcase (vla-get-tagString AcDbAttrib)))) (vlax-invoke AcDbBlkRef 'getAttributes))))
  
 ; here start c:addtags 
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark adoc)
 (setvar "cmdecho" 0)
  
 (setq blocks (vla-get-blocks adoc))
  
 (setq TAGSCL 1)
 (setq TAGHGT 0.25)
 (setq DATATAGS '("WEIGHT" "ELEMENT_CATEGORY"))

 (setq ctr0 0)
 (if (setq ss (ssget '((0 . "insert"))))
  (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq AcDbBlkRef (vlax-ename->vla-object ename))
   (setq bname (vla-get-effectivename AcDbBlkRef))
   (setq taglst (_gettags)) 
    
   (if (tblsearch "block" bname)
    (progn
     (setq AcDbBlkTblRec (vla-item blocks bname)) 
     (setq hgt (* TAGHGT TAGSCL) ypos (- hgt))

     (setq ctr1 0)
     (foreach tag (reverse DATATAGS)
      (if (null (member (strcat tag) taglst))
       (progn	
        (setq ypos (+ ypos (* hgt 2))) 
        (setq AcDbAttdef (vla-addAttribute AcDbBlkTblRec hgt acAttributeModeLockPosition (strcase tag t)
			  					 (vlax-3d-point (list 0.0 ypos 0.0)) tag (strcase tag t)))
        (vla-put-layer AcDbAttdef "0")
        (vlax-release-object AcDbAttdef)
	(setq ctr1 (1+ ctr1))
       ); progn
      ); if
     ); foreach
     
     (vlax-release-object AcDbBlkTblRec)

     (if (> ctr1 0)
      (command "._attsync" "_name" bname)
     )
    ); progn
   ); if 

   (vlax-release-object AcDbBlkRef)
   (setq ctr0 (+ ctr0 ctr1))
  ); foreach
 ); if

 (vlax-release-object blocks)
 (prompt (strcat "\n" (itoa ctr0) " attribute(s) added."))
  
 (setvar "cmdecho" 1) 
 (vla-endundomark adoc) 
 (vlax-release-object adoc)
  
 (princ)
); c:addtags

 

 

 

Report
Message 3 of 13

pierre_costeS8GW8
Enthusiast
Enthusiast
in reply to Moshe-A
‎06-27-2023 12:24 AM

Hi,

 

First, Thank you very much for your time and your very clear answer.

 

It's 100% sure that my blocks have no attributes. I don't care about their positioning or size because i don't have tested your code but i will try to set them as invisible state.

 

I will try the code.

0 Likes
Like
Report
Message 4 of 13

pierre_costeS8GW8
Enthusiast
Enthusiast
in reply to Moshe-A
‎06-27-2023 12:27 AM
Thank you very much, it does work ... beauty and power of code !!
0 Likes
Like
Report
Message 5 of 13

Moshe-A
Mentor
Mentor
in reply to pierre_costeS8GW8
‎06-27-2023 12:53 AM

@pierre_costeS8GW8 

 

Glade to see you find it working, it is a little inefficient version so i will send you an update tonight

i will set them to be invisible plus if you have other requests like text style, font file, justification.... shoot now 😀

 

have a nice day

Moshe

 

 

 

0 Likes
Like
Report
Message 6 of 13

pierre_costeS8GW8
Enthusiast
Enthusiast
in reply to Moshe-A
‎06-27-2023 12:58 AM
If you could show me how to set them in invisible state it would be incredible.
Thank you so much.
Have a nice !
0 Likes
Like
Report
Message 7 of 13

Moshe-A
Mentor
Mentor
in reply to pierre_costeS8GW8
‎06-27-2023 01:17 AM
Accepted solution

here it is

 

 

change this:

(setq AcDbAttdef (vla-addAttribute AcDbBlkTblRec hgt acAttributeModeLockPosition (strcase tag t)
			  					 (vlax-3d-point (list 0.0 ypos 0.0)) tag (strcase tag t)))

 

to this:

(setq AcDbAttdef (vla-addAttribute AcDbBlkTblRec hgt acAttributeModeLockPosition+acAttributeModeInvisible (strcase tag t) (vlax-3d-point (list 0.0 ypos 0.0)) tag (strcase tag t)))
0 Likes
Like
Report
Message 8 of 13

pierre_costeS8GW8
Enthusiast
Enthusiast
‎06-27-2023 01:22 AM

Thank you it is all perfect !!

0 Likes
Like
Report
Message 9 of 13

pierre_costeS8GW8
Enthusiast
Enthusiast
‎06-27-2023 04:37 AM
(defun c:addtags (/ _gettags TAGSCL TAGHGT DATATAGS adoc blocks ss ename AcDbBlkRef bname AcDbBlkTblRec hgt ypos tag AcDbAttdef ctr0 ctr1)

  (setq _gettags (lambda () (mapcar (function (lambda (AcDbAttrib) (strcase (vla-get-tagString AcDbAttrib)))) (vlax-invoke AcDbBlkRef 'getAttributes))))
 
  ; here start c:addtags
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (setvar "cmdecho" 0)
 
  (setq blocks (vla-get-blocks adoc))
 
  (setq TAGSCL 1)
  (setq TAGHGT 0.25)
  (setq DATATAGS '("" "" "" "" "" ""  "" "" ""))

  (setq ctr0 0)
  (if (setq ss (ssget '((0 . "insert"))))
    (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq AcDbBlkRef (vlax-ename->vla-object ename))
      (setq bname (vla-get-effectivename AcDbBlkRef))
      (setq taglst (_gettags))
   
      (if (tblsearch "block" bname)
        (progn
          (setq AcDbBlkTblRec (vla-item blocks bname))
          (setq hgt (* TAGHGT TAGSCL))
          (setq ypos (- (* hgt (length DATATAGS)) hgt))

          (setq ctr1 0)
          (foreach tag (reverse DATATAGS)
            (if (null (member (strcat tag) taglst))
              (progn  
                (setq ypos (+ ypos hgt))
                (setq AcDbAttdef (vla-addAttribute AcDbBlkTblRec hgt acAttributeModeLockPosition+acAttributeModeInvisible (strcase tag t)
                                                   (vlax-3d-point (list 0.0 ypos 0.0)) tag (strcase tag t)))
                (vla-put-layer AcDbAttdef "0")
                (vlax-release-object AcDbAttdef)
                (setq ctr1 (1+ ctr1))
              ); progn
            ); if
          ); foreach
     
          (vlax-release-object AcDbBlkTblRec)

          (if (> ctr1 0)
            (command "._attsync" "_name" bname)
          )
        ); progn
      ); if

      (vlax-release-object AcDbBlkRef)
      (setq ctr0 (+ ctr0 ctr1))
    ); foreach
  ); if

  (vlax-release-object blocks)
  (prompt (strcat "\n" (itoa ctr0) " attribute(s) added."))
 
  (setvar "cmdecho" 1)
  (vla-endundomark adoc)
  (vlax-release-object adoc)
 
  (princ)
); c:addtags
 
Here is attached the code adapted to the length of the list.
 
A big thanks to Moshe-A !
0 Likes
Like
Report
Message 10 of 13

Moshe-A
Mentor
Mentor
in reply to pierre_costeS8GW8
‎06-27-2023 06:33 AM

you reset (all) DATATAGS? why is that?

 

do me a faviour, correct this code line to be 😀

 

(setq AcDbAttdef (vla-addAttribute AcDbBlkTblRec hgt acAttributeModeLockPosition+acAttributeModeInvisible (strcase tag t) (vlax-3d-point (list 0.0 ypos 0.0)) tag (strcase tag t)))
 
Tags (0)

 

0 Likes
Like
Report
Message 11 of 13

pierre_costeS8GW8
Enthusiast
Enthusiast
in reply to Moshe-A
‎06-27-2023 07:44 AM
I just clear the list DATATAGS for those who might want to set their own attribute tags
0 Likes
Like
Report
Message 12 of 13

Moshe-A
Mentor
Mentor
in reply to pierre_costeS8GW8
‎06-27-2023 12:19 PM

@pierre_costeS8GW8 

 

here is the efficient (and final) version 😀 

 

enjoy

Moshe

 

(vl-load-com)

(defun c:addtags (/ LM:lst->str LM:Unique blocks_name gettags message ; local function
                    TAGSCL TAGHGT DATATAGS AcDbBlkTblRec AcDbAttdef ctr adoc ss bname taglst hgt ypos flag tag blk2upd)
  
 ;; List to String  -  Lee Mac
 ;; Concatenates each string in a supplied list, separated by a given delimiter
 ;; lst - [lst] List of strings to concatenate
 ;; del - [str] Delimiter string to separate each item

 (defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
 )
  
 ;; Unique  -  Lee Mac
 ;; Returns a list with duplicate elements removed.

 (defun LM:Unique ( l )
   (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
 )
  
 (defun blocks_name ()
  (LM:Unique 
   (mapcar
     (function
        (lambda (AcDbBlkRef)
         (vla-get-effectivename AcDbBlkRef)
        ); lambda
     ); function
     (mapcar (function (lambda (ename) (vlax-ename->vla-object ename))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) 
   ); mapcar
  ); LM:Unique
 ); blocks_name

  
 (defun gettags (/ AcDbEntity lst)
  (vlax-for AcDbEntity AcDbBlkTblRec
   (if (eq (vla-get-objectname AcDbEntity) "AcDbAttributeDefinition")
    (setq lst (cons (vla-get-tagString AcDbEntity) lst))
   )
    
   (vlax-release-object AcDbEntity) 
  ); vlax-for
   
  lst 
 ); gettags

  
 (defun message ()
  (cond
   ((= (vl-list-length blk2upd) 0)
    (prompt "\nno tags added.")
   ); case
   ((= (vl-list-length blk2upd) 1)
    (prompt (strcat "\n" (itoa ctr) " tag(s) added, 1 block was synchronize."))
   ); case
   ( t
    (prompt (strcat "\n" (itoa ctr) " tag(s) added, " (itoa (vl-list-length blk2upd)) " blocks were synchronize."))
   ); case
  ); cond
 ); message
 
  
 ; here start c:addtags 
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark adoc)
 (setvar "cmdecho" 0)
  
 (setq TAGSCL 1)
 (setq TAGHGT 0.25)
 (setq DATATAGS '("WEIGHT" "ELEMENT_CATEGORY"))

 (setq ctr 0) ; counter for added tags
  
 (if (setq ss (ssget '((0 . "insert"))))
  (foreach bname (blocks_name)
   (setq AcDbBlkTblRec (vla-item (vla-get-blocks adoc) bname))
    
   (setq taglst (gettags) hgt (* TAGHGT TAGSCL) ypos (- hgt))
   (foreach tag (reverse DATATAGS)
    (if (null (member (strcat tag) taglst))
     (progn	
      (setq ypos (+ ypos (* hgt 2)) ctr (1+ ctr) flag t) 
      (setq AcDbAttdef (vla-addAttribute AcDbBlkTblRec hgt (+ acAttributeModeLockPosition acAttributeModeInvisible)
			 		(strcase tag t) (vlax-3d-point (list 0.0 ypos 0.0)) tag (strcase tag t)))
      (vla-put-layer AcDbAttdef "0")
      (vlax-release-object AcDbAttdef)
     ); progn
    ); if
   ); foreach

   
   (if flag
    (setq blk2upd (cons bname blk2upd))
   )

   (setq flag nil) 
   (vlax-release-object AcDbBlkTblRec)
  ); foreach
 ); if


 (if blk2upd 
  (command "._attsync" "_name" (LM:lst->str blk2upd ","))
 )
 (message) 
  
 (setvar "cmdecho" 1) 
 (vla-endundomark adoc) 
 (vlax-release-object adoc)
  
 (princ)
); c:addtags

 

 

0 Likes
Like
Report
Message 13 of 13

Village_Idiot
Contributor
Contributor
in reply to Moshe-A
‎03-04-2025 09:55 AM

Thank you so much for this @Moshe-A. I have made minor tweaks and its been speeding things up for a few months now.  I wonder if you would mind making a tweak that is a bit beyond me?  Could it be made to delete any attribute definitions that do not show up in DATATAGS and any attributes that are in both DATATAGS and TAGLST (att's in the exist block) get put in the order they show in DATATAGS?

0 Likes
Like
Report
Report a website issue