[编程交流] 属性值更新全局

^C^C-attedit;n;n;;DT3;;;MEP-;

....removed...

(defun c:Test (/ tag ss lock)
 ;; Tharwat 22. Oct. 2013    ;;
 (or acdoc
     (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (vlax-for x (vla-get-layers acdoc)
   (if (eq :vlax-true (vla-get-lock x))
     (vla-put-lock (car (setq lock (cons x lock))) :vlax-false)
   )
 )
 (if (setq tag "DT3"
           ss  (ssget "_X"
                      '((0 . "INSERT") (66 . 1) (2 . "Title-A1-Text"))
               )
     )
   (progn
     (vla-StartUndoMark acdoc)
     ((lambda (x / sn e)
        (while (setq sn (ssname ss (setq x (1+ x))))
          (while
            (and (setq sn (entnext sn))
                 (/= (cdr (assoc 0 (setq e (entget sn)))) "SEQEND")
            )
             (if (and (eq (cdr (assoc 0 e)) "ATTRIB")
                      (eq (strcase (cdr (assoc 2 e))) tag)
                 )
               (entmod (subst (cons 1 (strcat "MEP " (cdr (assoc 1 e))))
                              (assoc 1 e)
                              e
                       )
               )
             )
          )
        )
      )
       -1
     )
     (vla-EndUndoMark acdoc)
   )
 )
 (foreach layer lock (vla-put-lock layer :vlax-true))
 (vla-regen acdoc AcAllViewports)
 (princ)
)
(vl-load-com)

(defun c:c2 (/ ss i e tag str_ str)
   (setq tag  "DT3"
  str_ "*PART*"
   )
   (if        (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1)(2 . "`*U*,Title_A1_Text")(410 . "~Model"))))
     (repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
(if (and (Eq (Strcase (vla-get-effectivename e)) "TITLE_A1_TEXT")
         (vlax-write-enabled-p e))
  (vl-some
    '(lambda (x)
       (if
         (and
           (eq (vla-get-tagstring x) tag)
           (wcmatch (strcase (setq str (vla-get-textstring x))) str_)
           (not (wcmatch str "[MmEePp]*"))
         )
;;; in case layer "0" is also locked considering        ;;;
;;; most blocks are created at layer "0"                ;;;
          (vl-catch-all-error-p
            (vl-catch-all-apply
              'vla-put-textstring
              (list x (strcat "MEP " str))
            )
          )
;;;                                                        ;;;
       )
     )
    (vlax-invoke e 'Getattributes)
  )
)
     )
   )
   (princ)
 )