UPDATE ATTRIBUTE VALUE BY TAG NAME REGARDLESS OF BLOCK NAME

UPDATE ATTRIBUTE VALUE BY TAG NAME REGARDLESS OF BLOCK NAME

Anonymous
Not applicable
541 Views
3 Replies
Message 1 of 4

UPDATE ATTRIBUTE VALUE BY TAG NAME REGARDLESS OF BLOCK NAME

Anonymous
Not applicable

Hi all 

could anybody here help me in this , I need a lisp routine that update attribute value by the tag of attribute regardless of block name . ? 

0 Likes
542 Views
3 Replies
Replies (3)
Message 2 of 4

marko_ribar
Advisor
Advisor

Untested, but maybe something like this :

 

(defun c:updateattsbytag ( / tag str ss i bl blvla )
  (if
    (and
      (setq tag (getstring "\nSpecify TAG name : "))
      (snvalid tag)
      (setq str (getstring t "\nSpecify text string to be applied to attribute tag : "))
      (snvalid str)
    )
    (progn
      (if (not (equal '(nil nil) (sssetfirst nil (ssget "_X" '((0 . "INSERT") '(66 . 1))))))
        (setq ss (ssget "_:L"))
      )
      (repeat (setq i (sslength ss))
        (setq bl (ssname ss (setq i (1- i))))
        (setq blvla (vlax-ename->vla-object bl))
        (foreach att (append (vlax-invoke blvla 'getattributes) (vlax-invoke blvla 'getconstantattributes))
          (if (= (strcase tag) (vla-get-tagstring att))
            (vla-put-textstring att str)
          )
        )
      )
    )
  )
  (princ)
)

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 3 of 4

Anonymous
Not applicable

thnx for your help , I really  appreciate .

i got something like what you post from cadalyst , it's below ( bold one ). 

but what i want is to select the attribute instead of typing it , 

 

(setq tagname (getstring T "Enter Tag Name: ")

 

I'm new here , so I try to look up about another program and replace with this .

 

(defun c:test (/ atb_blk)
(vl-load-com)
(if (setq atb_blk (car (entsel)))
(progn
(setq atb_blk (vlax-ename->vla-object atb_blk) txt_val nil)
(if
(and
(eq (vla-get-objectname atb_blk) "AcDbBlockReference")
(eq (vla-get-hasattributes atb_blk) :vlax-true))
(foreach
txt_str (vlax-invoke atb_blk 'GetAttributes)
(setq txt_val (cons (vla-get-TextString txt_str) txt_val))
(princ (strcat "\nTag Name: " (vla-get-TagString txt_str)))
(princ (strcat "\n\t\t\t" (vla-get-TextString txt_str))))

(princ "\nNo attribuets found:"))
)

(princ "\nNothing selected"))
(princ))

 

 

could you help me ? 

-------------------------------------------------------------------------------------

 

;;TIP 1038: GMTAGS.LSP (C)1994, Ed Gyulai
;;
;; Globally Modifies Tag Values, All Blocks
;;===========================================================
(defun C:GMTAGS ( / tagname newv ss1 len count bn en el found)
(setq tagname (getstring T "Enter Tag Name: ")
newv (getstring T "Globally Change Value to: "))
;=================create selection set=======================
(setq ss1 (ssget "x" '((0 . "insert") (66 . 1)))
len (sslength ss1)
count 0)
(repeat len
(setq bn (ssname ss1 count) ;Block Name
en (entnext bn) ;Entity Name
el (entget en)) ;Entity List
;=================loop thru block entities===================
(while (and (= "ATTRIB" (dxf 0 el))
(/= "SEQEND" (dxf 0 el)))
(if (= (dxf 2 el) (strcase tagname))
(progn
(setq el (subst (cons 1 newv) (assoc 1 el) el))
(entmod el) ;Modify List
(entupd bn) ;Update Screen
(setq found "yes") ;Found Tag?
) ;progn
) ;if
(setq en (entnext en)
el (entget en))
) ;while
(setq count (1+ count))
) ;repeat
(if (/= found "yes")
(princ "\nTag Not Found.")
)
(princ)
);defun gmtags.lsp
;======================dxf function==========================
(defun dxf (code elist)
(cdr (assoc code elist))
);dxf
(princ)
;============================================================


0 Likes
Message 4 of 4

braudpat
Mentor
Mentor

 

Hello Marko

 

I have tried your routine on my French ACAD 2016 and I get an error !

 

Commande: UPDATEATTRBYTAG

Specify TAG name : lum_typelamp

Specify text string to be applied to attribute tag : XXXXX
; erreur: liste SSGET incorrecte

 

Regards, Patrice

 

Patrice ( Supporting Troops ) - Autodesk Expert Elite
If you are happy with my answer please mark "Accept as Solution" and if very happy please give me a Kudos (Felicitations) - Thanks

Patrice BRAUD

EESignature


0 Likes