[编程交流] 查找和替换属性值

;; cav.lsp
;; change attribute values by given pattern
(defun C:CAV (/ *error* adoc atts cnt layer locked newvalue oldvalue)
;; error trapping function
(defun *error* (msg)
 (if (and msg
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
)
     )
   )
    (princ (strcat "Error >>> " (princ msg)))
    (princ msg)
    )
 (vla-endundomark
   (vla-get-activedocument
     (vlax-get-acad-object))
   ) 
    )
 (setq adoc (vla-get-activedocument
     (vlax-get-acad-object))
       )
 (vla-startundomark adoc)
 (setq cnt 0)
 ;; loop through all layouts
 (vlax-for layout  (vla-get-layouts adoc)
   (vlax-for obj  (vla-get-block layout)
     (if (and (eq "AcDbBlockReference" (vla-get-objectname obj))
    (eq :vlax-true (vla-get-hasattributes obj)))
(progn
  (setq layer (vla-item (vla-get-layers adoc) (vla-get-layer obj)))
  (if (eq :vlax-true (vla-get-lock layer))
    (progn
      (setq locked (cons (vla-get-layer obj) locked))
      (vla-put-lock layer :vlax-false))   ;<--unlock layer if locked
    )
  (setq atts (vlax-invoke obj 'GetAttributes))
  (foreach att atts
    (setq oldvalue (vla-get-textstring att)) ;<--get attribute value
    (if (wcmatch oldvalue "CA*") ;<-- CA* is attribute pattern, change to suit
      (progn
 (setq cnt (1+ cnt))    ;<--increment counter
 (setq newvalue (vl-string-subst "D" "A" oldvalue)) ;<--change patterns(letters) to suit
 (vla-put-textstring att newvalue) ;<--set new attribute value
 (vla-update att)
 (princ (strcat "\n\t\t\t\t\>> Attribute value "
         (vl-princ-to-string oldvalue)
         " changed on: "
         (vl-princ-to-string newvalue)))
 )
      )
    )
  (vla-update obj)
  )
)
     )
   )
 ;; turn all layers state back 
(if locked
 (foreach layer  locked
   (vla-put-lock
     (vla-item (vla-get-layers adoc) layer)
     :vlax-true))
 )
(setq locked nil)
(alert (strcat "Done. Processed "
       (itoa cnt)
       " attributes on all layouts"))
(*error* nil)
(princ)
 )
(prompt"\n\t\t\t\tType CAV to change attributes by pattern")
(princ)
(vl-load-com);_end of code

(defun c:attupd (/ i ss ent att) (vl-load-com) (or *def_com* (setq *def_com* "NORTH")) ;; First-time Default (if (and (setq i -1 ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))          (not (initget "NORTH SOUTH EAST WEST"))          (setq *def_com* (cond ((getkword (strcat "\nNorth/South/East/West?  : ")))                                (*def_com*))))                  (while (setq ent (ssname ss (setq i (1+ i))))     (foreach att (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes)       (and (eq "COMMENTS" (strcase (vla-get-TagString att)))            (vla-put-TextString att (strcat "LKG. " *def_com* (vla-get-TextString att)))))))  (princ))