Not as elegant as I would have liked, but try this :
(vl-load-com)
(defun rh:put_properties ( obj1 obj2 p_lst / f_lst txt)
(cond ( (> (length p_lst) 0)
(foreach prop p_lst
(cond ( (and (vlax-property-available-p obj2 prop T)
(vlax-property-available-p obj1 prop)
)
(vlax-put-property obj2 prop (vlax-get-property obj1 prop))
)
( (vlax-property-available-p obj2 prop)
(setq ro_lst (cons prop ro_lst))
)
( (setq f_lst (cons prop f_lst)))
);end_cond
);end_foreach
);end property list exists
( (= (length p_lst) 0)
(alert "Passed Property List is Empty")
);end property list doesn't exists
);end_cond
(cond ( (or (> (length f_lst) 0) (> (length ro_lst) 0))
(setq txt
(strcat "Not "(vlax-get-property obj2 'objectname) " Properties.\n"
(foreach prop f_lst (setq txt (strcat txt prop " ")))
"\n(RO) Properties\n"
(foreach prop ro_lst (setq txt (strcat txt prop " ")))
);end_strcat
);end_setq
(alert txt)
);end problem properties
);end_cond
);end_defun
(defun rh:convert2txt ( obj txt / ms i_pt n_obj rtn)
(setq ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(if (= (vlax-get-property obj 'alignment) 0)
(setq i_pt (vlax-get-property obj 'insertionpoint))
(setq i_pt (vlax-get-property obj 'textalignmentpoint))
);end_if
(setq n_obj (vla-addtext ms txt i_pt (vlax-get-property obj 'height))
);end_setq
(rh:put_properties obj n_obj (list 'stylename 'alignment 'scalefactor 'color))
(vla-delete obj)
(setq rtn n_obj)
);end_defun
(defun c:att2txt (/ *error* c_doc a_ent ent_lst tag blk_ent tmp_obj b_name ss blk_name atts a_tag a_val a_att c_obj c_lyr c_col x_objs e_obj)
(defun *error* ( msg )
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occured.")))
(princ)
);_end_*error*_defun
(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
a_ent (nentsel "\Select Attribute to convert to text : ")
ent_lst (entget (car a_ent))
tag (strcase (cdr (assoc 2 ent_lst)))
blk_ent (cdr (assoc 330 ent_lst))
tmp_obj (vlax-ename->vla-object blk_ent)
cnt 0
);end_setq
(setq b_name (strcase (if (vlax-property-available-p tmp_obj 'effectivename)
(vlax-get-property tmp_obj 'effectivename)
(vlax-get-property tmp_obj 'name)
)
)
)
(initget "Yes No")
(setq ans "Yes"
ans (getkword (strcat "\nSelect More Blocks [Yes / No] < " ans " > : "))
)
(if (= ans "Yes")
(progn
(prompt "\nSelect Blocks : ")
(while (not ss)
(setq ss (ssget '((0 . "INSERT") (66 . 1))))
(if (not ss) (alert "You must Select at least One other Entity"))
);end_while
);end_progn
(setq ss (ssadd blk_ent))
)
(if (not (ssmemb blk_ent ss)) (ssadd blk_ent ss))
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(vla-startundomark c_doc)
(repeat (sslength ss)
(setq b_obj (vlax-ename->vla-object (ssname ss cnt))
cnt (1+ cnt)
blk_name (if (vlax-property-available-p b_obj 'effectivename)
(vlax-get-property b_obj 'effectivename)
(vlax-get-property b_obj 'name)
)
);end_setq
(cond ( (= (strcase blk_name) b_name)
(setq atts (vlax-invoke b_obj 'getattributes))
(foreach att atts
(if (= (strcase (vlax-get-property att 'tagstring)) tag)
(setq a_att att
a_val (vlax-get-property att 'textstring)
)
);end_if
);end_foreach
)
);end_cond
(setq c_obj (vla-copy b_obj)
c_lyr (vlax-get-property c_obj 'layer)
c_col (vlax-get-property c_obj 'color)
x_objs (vlax-invoke c_obj 'explode)
)
(vla-delete c_obj)
(foreach obj x_objs
(cond ( (and (= (vlax-get-property obj 'objectname) "AcDbAttributeDefinition")
(= (strcase (vlax-get-property obj 'tagstring)) tag)
);end_and
(setq e_obj (rh:convert2txt obj a_val))
(if (= (vlax-get-property e_obj 'layer) "0") (vlax-put-property e_obj 'layer c_lyr))
(if (= (vlax-get-property e_obj 'color) 0) (vlax-put-property e_obj 'color c_col))
);end_cond attribute
(
(vla-delete obj)
)
);end_cond
);end_foreach
(vlax-put-property a_att 'textstring "")
);end_repeat
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
);end_defunThe initial selection requires you to select the attribute within the block you wish to extract. It finds the block name and attribute tag itself.
The prompt to select more blocks is to enable you to select several other similar blocks with the same effective name. If you answer "Yes" (the default) you will be prompted to select. If you select "No" then the block initially selected block only is added to the selection set. The routine will also check if the intially selected block is in the selecton set and if not it adds it.
There is no check at present that the initial selection is an attribute. I will sort this sometime this evening.
I am not one of the robots you're looking for
