Results 1 to 6 of 6

Thread: Update Mtext Attribute Blocks

  1. #1
    Login to Give a bone
    0

    Default Update Mtext Attribute Blocks

    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
    Code:
    ;-------------------------------------------------------------------------------
    ; 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
    Attached Files Attached Files
    Last edited by Ed Jobe; 2019-06-26 at 10:18 PM. Reason: Added CODE tags

  2. #2
    I could stop if I wanted to devitg.89838's Avatar
    Join Date
    2005-06
    Location
    CORDOBA-ARGENTINA
    Posts
    253
    Login to Give a bone
    0

    Default Re: Update Mtext Attribute Blocks

    Please Upload your sample.dwg

  3. #3
    Login to Give a bone
    0

    Default Re: Update Mtext Attribute Blocks

    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
    Attached Files Attached Files

  4. #4
    All AUGI, all the time Tharwat's Avatar
    Join Date
    2010-06
    Posts
    897
    Login to Give a bone
    0

    Default Re: Update Mtext Attribute Blocks

    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.

    Code:
    (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)
               )
      )

  5. #5
    Login to Give a bone
    0

    Default Re: Update Mtext Attribute Blocks

    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.

    Code:
    ;-------------------------------------------------------------------------------
    ; 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
    ;-------------------------------------------------------------------------------
    Attached Files Attached Files
    Last edited by Terry Cadd; 2019-07-05 at 05:43 PM. Reason: Added code tag.

  6. #6
    All AUGI, all the time Tharwat's Avatar
    Join Date
    2010-06
    Posts
    897
    Login to Give a bone
    0

    Default Re: Update Mtext Attribute Blocks

    Excellent to hear that.

    You're welcome anytime.

Similar Threads

  1. Replies: 0
    Last Post: 2012-11-14, 03:10 PM
  2. Attribute blocks fail to update
    By spencer.lepler in forum AutoCAD General
    Replies: 3
    Last Post: 2007-08-27, 09:20 PM
  3. Replies: 5
    Last Post: 2007-07-03, 02:52 PM
  4. Replies: 5
    Last Post: 2006-08-11, 01:32 PM
  5. Replies: 3
    Last Post: 2006-04-10, 11:11 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •