LISP - ATTACH EXISTING TEXT TO AN EXISTING BLOCK AS AN ATTRIBUTE

[Anonymous]

Hello,

Need some help creating a LISP for the following.

A) I have a block. This Block has an Attribute defined (tag) named as number
B) I have a text in the drawing. I want to convert/attach this text as an attribute (as a value to the tag named number) to the above block . 

C) Also, I want the text layer to be retained as it was originally (when it was just a text) after it is moved to an attribute of that block

Any help on this would be really appreciated. Thank you in advance.

[3wood]

Are they next to each other?

Can you upload a sample drawing?

[Anonymous]

Hi 3Wood,

Yes most of them are, but would like an option where in I can select the Text and the block, so it know that that specific text needs to get attached to that specific block. Wont mind manually selecting the text and block.

Does that help ?

Thanks.

[Moshe-A]

@Anonymous  hi,

check this one

enjoy

moshe

(vl-load-com)

(defun c:tembed (/ ss ename0 ename1 tmp elist0 elist1 text)
  
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (setq ss (ssget '((0 . "mtext,text,insert"))))
  (cond
   ((= (sslength ss) 1)
    (vlr-beep-reaction)
    (prompt "\nto few objects selected.")
   ); case
   ((> (sslength ss) 2)
    (vlr-beep-reaction)
    (princ "\nto many obvjects selected.")
   )
   ( t
    (setq elist0 (entget (setq ename0 (ssname ss 0))))
    (setq elist1 (entget (setq ename1 (ssname ss 1))))

    ; make sure text is in elist0
    (if (wcmatch (cdr (assoc '0 elist0)) "INSERT")
     (setq tmp ename0 ename0 ename1 ename1 tmp
           tmp elist0 elist0 elist1 elist1 tmp)
    ); if

    (if (= (cdr (assoc '66 elist1)) 1) ; does block has attributes
     (progn
      (setq text (cdr (assoc '1 elist0)))
      (setpropertyvalue ename1 "tag" text) 
     ); progn
    ); if
   ); case
  ); cond
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ) 
); tembed

[Anonymous]

Hi Moshe,

Thanks for the lisp routine. Unfortunately it doesn't work. Nothing seems to happen after I select 1 text and 1 block. the text is not transferred to the block as its attribute 😞

[Moshe-A]

@Anonymous  hi,

well it will work if your block has an attribute with tag name TAG (didn't you said that's what you have?)

[dbhunia · Accepted solution]

you can try this way...(hopefully you can manage the rest)

(defun C:Add_Tag ( / Text Txt_Ent BLK Txt_Lay Txt_Height def)
(setvar "cmdecho" 0)
(setq Text (cdr (assoc 1 (entget (setq Txt_Ent(car(entsel "\nSelect Text: ")))))))
(setq BLK (cdr (assoc 2 (entget (car(entsel "\nSelect Block: "))))))
(setq Txt_Lay (vlax-get (vlax-ename->vla-object Txt_Ent) 'layer))
(setq Txt_Height (vlax-get (vlax-ename->vla-object Txt_Ent) 'height))
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) BLK))
(vla-addattribute def
	 Txt_Height
	 acattributemodelockposition
	 Text
	 (vlax-3D-point 0 (- (* 1.5 Txt_Height)))
	 Text
	 Text
)
(vlax-for obj def
    (if (wcmatch (vla-get-objectname obj) "AcDbAttribute*")
        (if (wcmatch (setq tagstr (vla-get-tagstring obj)) Text)
			(vl-catch-all-apply 'vla-put-layer (list obj Txt_Lay))
		)
	)
)
(command "_.attsync" "_N" BLK)
(setvar "cmdecho" 1)
)

[Anonymous]

Hi Moshe,

I did try having the tag name as "tag" in my block and, it wont work still. 😞

Thanks,

R

[Anonymous]

Hi Debashis,

Thank you so much. This almost works perfectly.

It does attach the text as an attribute to the block.

Only issue is, there are many instances of the same block in the drawing and when i attach one text to one block it attaches that text to all blocks in the drawing. I just wanted it to attach the text only to that block which i select and not all the instances of the blocks.

This routine works, just need to amend it a little. Im not that good at lisp, would you be able to help me, please ?

Thanks,

R

[john.uhden]

It's really not all that difficult to do.

I'm at my wife's laptop right now, but all it requires is getting the attribute entity (vla-object) of the block insertion, getting the textstring and layer of the text entity, and vlax-put those properties to the attribute.

We really like to help people help themselves, not create freebies.  Have you any AutoLisp experience?

BTW, it's a good thing that the block already has an attribute to use.

I have been able to delete attributes from block references (insertions), but I doubt you can add an attribute to an insertion without redefining the block definition.  Then again, @dbroad  or @ВeekeeCZ  or @Kent1Cooper  or @DannyNL  or many others whom I respect and are more clever and sane and younger than myself will probably demonstrate otherwise.

[Sea-Haven · Accepted solution]

For any one looking at this to work with any block use nentsel and pick attribute to be changed this gives Tag name then use the pick point to repick the block and its easy then to update the one block attribute. I have something somewhere will try to find.

; Select attribute up date with pick text
; By Alan H July 2019


(defun txt2att ( / ss pt ent txt oldsnap)
(while (setq ent (nentsel "Pick Attribute"))
(setq pt (cadr ent))
(setq tag (cdr (assoc 2  (entget (car ent)))))
(setq ent (entsel "pick text"))
(setq txt (cdr (assoc 1  (entget (car ent)))))
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq ss (ssget pt))
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS 0 )) 'getattributes)
        (if (= tag (strcase (vla-get-tagstring att)))
        (vla-put-textstring att txt)
        )
)
)
(setvar 'osmode oldsnap)
(princ)
)
(txt2att)

[dlanorh]

---

@john.uhden wrote:

but I doubt you can add an attribute to an insertion without redefining the block definition. 

---

Many moons ago, I came across a block with attributes, but when opened in the block editor it had NO attributes. I eventually worked out how this was done.

Attached is a block with two attribute but only one in the block editor

[john.uhden]

Ah, there's a name I forgot to mention.

Okay, so how was it done (he said panting in anticipation)?

[dlanorh]

You just entmake a new block reference, using the old one as a template and add in the extra attribute.

It's fully functional, but a nightmare when you need to update the base block.

[john.uhden]

That sounds too easy. But whaddya mean "using the old one as a template?"
All you need is the name, right?
But when you entmake a block reference, how can you add to it? It's not as
though you are entmaking a block definition which requires an ENDBLK.

[Anonymous]

Thanks sea.heaven 🙂

[dlanorh]

---

@john.uhden wrote:
That sounds too easy. But whaddya mean "using the old one as a template?"
All you need is the name, right?
But when you entmake a block reference, how can you add to it? It's not as
though you are entmaking a block definition which requires an ENDBLK.

---

I don't want to post the complete code, so if you want that PM me. Below is the main (collection routine) and the sub that re-makes the block. If there are existing attributes the new att will attempt to take on the style, ht width ets of the existing. If not the current text style , text size and text style width are used and the att defaults to middle center alignment. I've commented part of the code.

; Pass in the info collected from the main routine

(defun rh:add_att (ent tag tstr pt lyr / ents a_lst p_lst)
  (setq ents (rh:get_ents ent)  ;get all the entities in the block
        a_lst (rh:att_lst ents) ;get a list of all the attributes if any
  );end_setq
  
  (if a_lst 
    (setq p_lst (rh:att_txt_props ents)) ;If there are any existing attributes get textstyle ht width horiz alignment vert alignment
    (setq p_lst (rh:current_text_style)) ;If not get current textstyle style ht width horiz & vert alignment defaults to middle center 
  );end_if
  
  ;recreate block
  (entmake (append (rh:filter_dxf (entget ent) (list 0 2 6 8 10 41 42 43 48 50)) (list (cons 66 1)))) ;make new block using only the dxf codes listed and tag has attributes code onto end
  (if a_lst
    (foreach att a_lst
      (entmake (rh:filter_dxf att (list 0 1 2 7 8 10 11 40 41 50 51 62 67 70 71 72 73 74 210))) ;If there are existing atts make them
    );end_foreach
  );end_if
  
  ;;add new attribute
  (entmake  (list '(0 . "ATTRIB") (cons 1 tstr) (cons 2 tag) (cons 7 (nth 0 p_lst)) (cons 8 lyr) (cons 10 pt) (cons 11 pt)
                  (cons 40 (nth 1 p_lst)) (cons 41 (nth 2 p_lst)) '(50 . 0) '(67 . 0) '(70 . 0) '(71 . 0) (cons 72 (nth 3 p_lst)) '(73 . 0)
                  (cons 74 (nth 4 p_lst)) '(210 0.0 0.0 1.0) '(280 . 0)
            )
  )
  (entmake (list (cons 0 "SEQEND") (cons 8 (cdr (assoc 8 (entget ent)))))) ;make end of blk ref
  
  (entdel ent);delete existing entity
);end_defun

(defun c:aa2blk( / ent tag str pt)
  (setq ent (car (entsel "\nSelect a Block : "))
        tag (strcase (getstring "\nEnter TAG of New Attribute : "))
        str (getstring t "\nEnter TAG string Value : ")
        pt (getpoint "\nSelect Position of New Attribute : ")
  );end_setq
  (rh:add_att ent tag str pt "0");;defaults to layer "0" for new attribute
);end_defun

It's not perfect but did the required job until I had a chance to design a new block and write translation programs for the multiple different versions of the existing block that had sprung up.

[dbroad]

I'm only replying to this solved thread because I was notified by reference from @john.uhden .

IMO, I generally follow these guidelines:

1. The layer of all attributes should almost always be layer 0.  I personally don't like multilayer blocks. 
2. I prefer to write programs that don't depend on the tag names of attributes but it is sometimes necessary.
3. I prefer to have the attributes in a block reference match the attributes in the block definition, since an attsync or battman invocation can destroy the data otherwise. One advantage of attributes is the ability to extract those attributes to build tables.  Screwy blocks short circuit that capability.
4. A no-check solution to the OP follows:

   ;;replaces attribute text string with that of selected object and 
   ;;changes layer of attribute to layer of text object, minimal checking.
   (defun c:t2a  ( / txt att txtobj attobj)
     (if (and (setq txt (nentsel "\nSelect text object: "))
   	   (setq att (nentsel "\nSelect attribute: ")))
       (progn (setq txtobj (vlax-ename->vla-object (car txt)))
   	   (setq attobj (vlax-ename->vla-object (car att)))
   	   (vla-put-TextString attobj (vla-get-TextString txtobj))
   	   (vla-put-Layer attobj (vla-get-layer txtobj))
   	   (vla-put-color attobj acbylayer)
   	   ;;(vla-delete txtobj) ;delete text object (optional)
         ))
     (princ))

[dlanorh]

---

@dbroad wrote:

I'm only replying to this solved thread because I was notified by reference from @john.uhden .

IMO, I generally follow these guidelines:

1. The layer of all attributes should almost always be layer 0.  I personally don't like multilayer blocks. 
2. I prefer to write programs that don't depend on the tag names of attributes but it is sometimes necessary.
3. I prefer to have the attributes in a block reference match the attributes in the block definition, since an attsync or battman invocation can destroy the data otherwise. One advantage of attributes is the ability to extract those attributes to build tables.  Screwy blocks short circuit that capability.

---

I whole heartedly agree, which is why I didn't post the complete code. It was neccessary to employ this method as a temporary "fix" to allow the regular report generation from a block, which required the extra attribute. This block (one per building space/room) was soley composed of these orphaned attributes some of which had been added willy nilly, and uniqely identified each space/room accross approx 500 managed buildings on 50 ish sites.

A correct  block definition was produced incorporating all the neccessary orphaned attributes; and several translation lisps were then used to update every drawing accross all the managed facilities.

[john.uhden]

I've been thinking about this.  Perhaps the sequence goes like this...

1.  Create a block with 2 attdefs. <aka the chicken>

2.  Insert the block (create a reference) with the 2 attributes. <a double yolker>

3.  Redefine the block definition to remove one of the attdefs. <a GMO chicken>

An observer would not know which happened first, the chicken or the egg.