This something I pieced together from a larger routine so it may have some "features" along with.
This was written for specific attribute tagstrings so you will need to change them for your blocks. It will update multiple attributes with the same block. It will error out if you select something that is not an attributed block.
Good Blockin'
(defun c:inc (/ ref tobj tstr ttag sel)
;;;
(defun *dxf* (gcode elist)
(cdr (assoc gcode elist))
)
;;;
(defun *get_atts* (obj)
(vlax-invoke
(if (eq (type obj) 'ENAME)
(vlax-ename->vla-object obj)
obj
)
'getattributes
)
)
;;;
(defun find (attlist nlst)
(vl-remove-if-not
'(lambda (x)
(vl-remove-if-not
'(lambda (y)
(eq (vla-get-tagstring x) y)
)
nlst
)
)
attlist
)
)
;;;
(defun put (obj str lst)
(mapcar '(lambda (x)
(vl-catch-all-apply
'vla-put-textstring
(list (rt:remove obj x) str)
)
)
lst
)
)
;;;
(defun rt:remove (obj str)
(car
(vl-remove-if-not
'(lambda (x)
(eq (vla-get-tagstring x) str)
)
(*get_atts* obj)
)
)
)
;;;
(if (and (setq ref (car (entsel "\nSelect reference block: ")))
(eq "INSERT" (*dxf* 0 (entget ref)))
)
(progn
(setq tobj (car
(find (*get_atts* ref)
;;;;Change these to your tagstrings.
'("DOOR#" "999" "1" "101-1" "101-2" "DR360")
)
)
ttag (vla-get-tagstring tobj)
)
(if (eq "" (setq tstr (vla-get-textstring tobj)))
(setq tstr "0")
)
(while tstr
(setvar "ErrNo" 0)
(if (not
(setq
sel (car (entsel "\nSelect attribute to update: "))
)
)
(if (/= 52 (getvar "ErrNo"))
(princ "\nNo object selected, please try again: ")
(progn
(princ "\nRight click detected - Terminate program. ")
(setq tstr nil)
)
)
;;;Change these to your tagstrings
(cond ((not (setq tstr (itoa (1+ (atoi tstr))))))
((eq ttag "1") (put sel tstr '("1")))
((eq ttag "DR360") (put sel tstr '("DR360")))
((eq ttag "DOOR#")
(put sel tstr '("DOOR#" "240-DOOR#" "96-DOOR#"))
)
((eq ttag "999") (put sel tstr '("999" "101")))
((eq ttag "101-1") (put sel tstr '("101-1" "101-2")))
)
)
)
)
(*error* (princ "\nNothing selected. *INVALID*"))
)
)