Update Mtext Attribute Blocks

[Terry Cadd]

I'm looking for an AutoLISP routine that will update Mtext Attribute Blocks with a new string value.
There are 2 routines listed below for reference. The GetMtextAttrib routine gets a Mtext Attribute Block string value.
The PutEntNameAttrib routine only works for the traditional Text Attributes in Blocks.
This is the one that I need help on, to get it to work with Mtext Attributes in Blocks.
Both routines are in the attachment.
Thanks for your help.
Terry

;-------------------------------------------------------------------------------
; GetMtextAttrib - Get Block Mtext Attribute value
; Arguments: 2
;   EntityName^ = Entity name
;   AttrTag$ = Tag label of attribute
; Returns: Mtext Attribute value
;-------------------------------------------------------------------------------
(defun GetMtextAttrib (EntityName^ AttrTag$ / Text$)
  (vl-some '(lambda (x) (and (= (vla-get-tagstring x) AttrTag$)(setq Text$ (vla-get-textstring x))))
    (vlax-invoke (vlax-ename->vla-object EntityName^) 'getattributes)
  );vl-some
  (if (not Text$)
    (setq Text$ "")
  );if
  Text$
);defun GetMtextAttrib
;-------------------------------------------------------------------------------
; PutEntNameAttrib - Put Entity name Attribute value
; Arguments: 3
;   EntName^ = Entity name
;   AttrTag$ = Tag label of attribute
;   AttrVal$ = New value for attribute
; Returns: Changes attribute value
;-------------------------------------------------------------------------------
(defun PutEntNameAttrib (EntName^ AttrTag$ AttrVal$ / EntList@ EntTag$ EntType$ First)
  (if (= (type EntName^) 'ENAME)
    (progn
      (setq EntList@ (entget EntName^)
            EntType$ (cdr (assoc 0 EntList@))
            First t
      );setq
      (if (and (= EntType$ "INSERT") (assoc 66 EntList@))
        (while (/= (cdr (assoc 0 EntList@)) "SEQEND")
          (setq EntList@ (entget EntName^)
                EntType$ (cdr (assoc 0 EntList@))
                EntTag$  (cdr (assoc 2 EntList@))
          );setq
          (if (= EntType$ "ATTRIB")
            (if (and (= EntTag$ (strcase AttrTag$)) First)
              (progn
                (entmod (subst (cons 1 AttrVal$) (assoc 1 EntList@) EntList@))
                (entupd EntName^)
                (setq First nil)
              );progn
            );if
          );if
          (setq EntName^ (entnext EntName^))
        );while
      );if
    );progn
  );if
  (princ)
);defun PutEntNameAttrib

[devitg.89838]

Please Upload your sample.dwg

[Terry Cadd]

The attached drawing was created with AutoCAD 2019.
In the sample drawing is a block named "Fasteners"
with an Mtext Attribute named "FASTENER_DESCRIPTION".
A quick and easy way to get it's EntName^ is to paste the
following on the command line and test it with the functions.

(setq EntName^ (car (entsel)))

Thanks,
Terry

[Tharwat]

Hi,

I did not download the drawing since its saved with later version than mine (CAD 2017) but what you are asking for is somehow easy to handle without a drawing at least to me.

Retrieving or assigning attributes values are similar to Mtext attributes values but the only different thing is that the \\P to let the string appear in Multi-lines and the same way when you entmake any Mtext object.

Anyway here are two functions get & set and I think they are more than enough with what you are after.

(defun get:att:by:tag (ent tag / str)
  (if (vl-some '(lambda (x)
                  (and (= (vla-get-tagstring x) tag)
                       (setq str (vla-get-textstring x))
                       )
                  )
               (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
               )
    str
    ""
    )
  )
;;				;;
(defun set:att:by:tag (ent tag att)
  (vl-some '(lambda (x)
              (if (= (vla-get-tagstring x) tag)
                (progn (vla-put-textstring x att) t)
                )
              )
           (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
           )
  )

[Terry Cadd]

Hi Tharwat,
This is perfect for our application. I tried both routines this morning,
and I called my boss over to show him how it works.
He already has some ideas for new applications for our drawings.
I understand the "\\P" a line break symbol. I will also have to put these
in the string that I want to update the Mtext Attributes with.
Here is a FindReplace routine that can be used to remove the "\\P" symbol for clarity.
Example: (FindReplace "First line\\PSecond line" "\\P" " ") = "First line Second line"
Thanks for sharing you code with others.
Terry
P.S. I saved the sample drawing as 2013 version in the attachment.
That was the first version below 2019 in the saveas choices.

;-------------------------------------------------------------------------------
; FindReplace - Returns Str$ with Find$ changed to Replace$
; Arguments: 3
;   Str$ = Text string
;   Find$ = Phrase string to find
;   Replace$ = Phrase to replace Find$ with
; Syntax: (FindReplace "TO SCALE" "TO" "NOT TO")
; Returns: Returns Str$ with Find$ changed to Replace$
;-------------------------------------------------------------------------------
(defun FindReplace (Str$ Find$ Replace$ / Len# Num# Start#)
  (setq Len# (strlen Replace$))
  (while (setq Num# (vl-string-search Find$ Str$ Start#))
    (setq Str$ (vl-string-subst Replace$ Find$ Str$ Num#)
          Start# (+ Num# Len#)
    );setq
  );while
  Str$
);defun FindReplace
;-------------------------------------------------------------------------------

[Tharwat]

Excellent to hear that.

You're welcome anytime.