Jump to content

Change MText fonts and height

mjab8

By mjab8
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mjab8 Explorer

mjab8

Posted
Posted

Hi,

I have tried many lisp from few forums but fail to change this MText fonts to Standard style and height of 2.

I am using Autocad 2025. I have hundreds of drawings that are converted from Solid Edge that I need convert.

I only need to convert a few Mtext so prefer not to select global as there are more editing to do.

Somehow I changed my Standard text style to iso3098b.shx, it does not change the mtext. Attached sample .dwg.

Thanks

 

Mike

Drawing1.dwg

mjab8 Explorer

mjab8

Posted
  • Author
Posted

Even a match an existing text will help as well.

I have tried Lee Mac - Match Text Properties routine, somehow does not seem to work on this.

Saxlle Collaborator

Saxlle

Posted
Posted (edited)

Hi @mjab8,

 

Try this and see if it suits your needs:

  

(prompt "\nTo run a LISP type: CHMTXT")
(princ)

(defun c:CHMTXT ( / mtxt_height ent obj txt formatted_text)    
  (setq mtxt_height (getreal "\nEnter the Height:")
	   ent (car (entsel "\nSelect MTEXT:"))
	)
  (while (/= ent nil)
    (setq obj (vlax-ename->vla-object ent)
	  txt (cdr (assoc 1 (entget ent)))
	  formatted_text (LM:UnFormat txt T)
	  )
    (entmod (subst (cons 1 formatted_text) (cons 1 txt) (entget ent)))
    (vlax-put-property obj 'StyleName "Standard")
    (vlax-put-property obj 'Height mtxt_height)
    (prompt "\nTo finish execution press ESC!!!")
    (setq ent (car (entsel "\nSelect MTEXT:")))
    )
  (setq mtxt_height nil ent nil obj nil txt nil formatted_text nil)
  (princ)
  )

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)

 

You can find this subfunction on Lee Mac site UnFormat String.

 

Best regards.

Edited by Saxlle
mjab8 Explorer

mjab8

Posted
  • Author
Posted

Fantastic & thanks Saxlle.

 

Wonder if you can enhance it to keep the existing text underline (currently underline is not brought across) and able to applied to 'Notes' as attached .dwg?

 

Much appreciated.

Drawing1.dwg

Saxlle Collaborator

Saxlle

Posted
Posted (edited)

Hi @mjab8,

 

10 hours ago, mjab8 said:

Wonder if you can enhance it to keep the existing text underline (currently underline is not brought across)

 

Try this modification (Notice: if you don't input the value of the MTEXT height, it will be taken from the selected entity):

  

; ****************************************************************************************************
; Functions     :  CHMTXT
; Subfunctions  :  LM:UnFormat
; Description   :  Change the MTEXT to be at desired Height and add MTEXT to be Bold and Underline
; Author        :  SAXLLE
; Date          :  March 18, 2025
; ****************************************************************************************************

(prompt "\nTo run a LISP type: CHMTXT")
(princ)

(defun c:CHMTXT ( / mtxt_height ent paragraph obj txt txt1 txt2 formatted_text formatted_text1 formatted_text2 val1 val2 new_txt underline_txt)
  (setq mtxt_height (getreal "\nEnter the Height or press Enter for nil:")
	ent (car (entsel "\nSelect MTEXT:"))
	paragraph "\\P" ;; "\\P" new line
	)   
  
  (while (or (= ent nil) (/= (cdr (assoc 0 (entget ent))) "MTEXT"))
    (prompt "\nSelected entity must be MTEXT! Try again...")
    (setq ent (car (entsel "\nSelect MTEXT:")))
    (princ)
    )
  
  (while (/= ent nil)
    
    ;;1. cond
    (cond
      ((/= (cdr (assoc 3 (entget ent))) nil)
       (setq txt1 (cdr (assoc 3 (entget ent)))
	     formatted_text1 (LM:UnFormat txt1 T)
	     formatted_text1 (vl-string-trim " " formatted_text1))
       
       (if (/= (cdr (assoc 1 (entget ent))) nil)
	 (setq txt2 (cdr (assoc 1 (entget ent)))
	       formatted_text2 (LM:UnFormat txt2 T)
	       formatted_text2 (vl-string-trim " " formatted_text2)
	       )
	 )
       
       (if (/= formatted_text2 nil)
	 (setq new_txt (strcat formatted_text1 formatted_text2))
	 (setq new_txt (strcat formatted_text1))
	 )
       (setq underline_txt (strcat "{\\fSolid Edge ISO|b1|i0;""\\L" new_txt "\\l}") ;; "\\fSolid Edge ISO" is the name of the font (you can changed it), "|b1|" turn on Bold", "|i0|" turn off Italic",
	     									    ;; "\\L" turns underline on, "\\l" turns underline off
	     )
       (if (/= mtxt_height nil)
	 (progn
	   (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 (cdr (assoc 10 (entget ent)))) (cons 40 mtxt_height) (cons 41 (cdr (assoc 41 (entget ent))))
			  (cons 50 (cdr (assoc 50 (entget ent)))) (cons 71 7) (cons 72 1) (cons 7 "Standard") (cons 3 underline_txt)))
	   (entdel ent)
	   )
	 (progn
	   (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 (cdr (assoc 10 (entget ent)))) (cons 40 (cdr (assoc 40 (entget ent)))) (cons 41 (cdr (assoc 41 (entget ent))))
			  (cons 50 (cdr (assoc 50 (entget ent)))) (cons 71 7) (cons 72 1) (cons 7 "Standard") (cons 3 underline_txt)))
	   (entdel ent)
	   )
	 )
       )

      ;;2. cond
      ((/= (cdr (assoc 1 (entget ent))) nil)
       (setq obj (vlax-ename->vla-object ent)
	     txt (cdr (assoc 1 (entget ent)))
	     formatted_text (LM:UnFormat txt T)
	     formatted_text (vl-string-trim " " formatted_text)) ;; Remove spaces the beginning and end of a string if it's occured
       (if (/= (vl-string-position (ascii " ") formatted_text) nil)
	 (progn
	   (setq
	     val1 (substr formatted_text 1 (vl-string-position (ascii " ") formatted_text)) ;; The first text value from the beginning to the first "space" between two words
	     val2 (substr formatted_text (+ (vl-string-position (ascii " ") formatted_text) 2)) ;; The second text value from "space" to the end of word
	     new_txt (strcat val1 paragraph val2)
	     underline_txt (strcat "{\\fSolid Edge ISO|b1|i0;""\\L" new_txt "\\l}") ;; "\\fSolid Edge ISO" is the name of the font (you can changed it), "|b1|" turn on Bold", "|i0|" turn off Italic",
	     									    ;; "\\L" turns underline on, "\\l" turns underline off
	     )
	   (entmod (subst (cons 1 underline_txt) (cons 1 txt) (entget ent)))
	   (vlax-put-property obj 'StyleName "Standard") ;; Text Style is "Standard", if you want, you can change it
	   
	   (if (/= mtxt_height nil)
	     (vlax-put-property obj 'Height mtxt_height) ;; Put the Height from variable "mtxt_height" user input
	     (vlax-put-property obj 'Height (cdr (assoc 40 (entget ent)))) ;; Put the Height from selected MTEXT if variable "mtxt_height" is nil.
	     )
	   )
	 (progn
	   (setq
	     underline_txt (strcat "{\\fSolid Edge ISO|b1|i0;""\\L" formatted_text "\\l}") ;; "\\fSolid Edge ISO" is the name of the font (you can changed it), "|b1|" turn on Bold", "|i0|" turn off Italic",
	     									    ;; "\\L" turns underline on, "\\l" turns underline off
	     )
	   (entmod (subst (cons 1 underline_txt) (cons 1 txt) (entget ent)))
	   (vlax-put-property obj 'StyleName "Standard") ;; Text Style is "Standard"
	   
	   (if (/= mtxt_height nil)
	     (vlax-put-property obj 'Height mtxt_height) ;; Put the Height from variable "mtxt_height" user input
	     (vlax-put-property obj 'Height (cdr (assoc 40 (entget ent)))) ;; Put the Height from selected MTEXT if variable "mtxt_height" is nil.
	     )
	   )
	 )
       )
      )
    (prompt "\nTo finish execution press ESC!!!")
    (setq ent (car (entsel "\nSelect MTEXT:")))
    (while (or (= ent nil) (/= (cdr (assoc 0 (entget ent))) "MTEXT"))
      (prompt "\nSelected entity must be MTEXT! Try again...")
      (setq ent (car (entsel "\nSelect MTEXT:")))
      (princ)
      )
    )
  (setq mtxt_height nil ent nil paragraph nil obj nil txt nil txt1 nil txt2 nil formatted_text nil formatted_text1 nil formatted_text2 nil val1 nil val2 nil new_txt nil underline_txt nil)
  (prompt "\nThe changes has been done!")
  (princ)
  )

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)

 

10 hours ago, mjab8 said:

able to applied to 'Notes' as attached .dwg

 

For this part, it will make a new entity (MTEXT), but it is hard to accomplish the desired output (it have many obstacles). Maybe someone else can update the code, or give a suggestion how to avoid that and get desired output.

 

I hope it will be helpful.

Edited by Saxlle
mjab8 Explorer

mjab8

Posted
  • Author
Posted

Saxlle, this one does not work. It's not changing the fonts as the one before. For the underline, it's only needed if the existing text is underline. It's not meant for every mtext. Sorry for not clarify this. Have strange result on large amount of mtext as the Notes in attached Drawin2.dwg, a lot of words truncated.

All texts height are 2.0, except underline texts are 2.5.  Thanks

Drawing2.dwg

Saxlle Collaborator

Saxlle

Posted
Posted (edited)

Hey @mjab8,

 

Try this modified code:

  

; ****************************************************************************************************
; Functions     :  CHMTXT
; Subfunctions  :  LM:UnFormat
; Description   :  Change the MTEXT to be at desired Height and add MTEXT to be Bold and Underline
; Author        :  SAXLLE
; Date          :  March 18, 2025
; Update 1.0    :  Optimized the code and add a solution using wcmatch for paragraph and underline
; Update date   :  March 19, 2025
; ****************************************************************************************************

(prompt "\nTo run a LISP type: CHMTXT")
(princ)

(defun c:CHMTXT ( / mtxt_height ent obj txt txt1 txt2 formatted_text formatted_text1 formatted_text2 val new_txt underline_txt)
  (setq ent (car (entsel "\nSelect MTEXT:")))   
  
  (while (or (= ent nil) (/= (cdr (assoc 0 (entget ent))) "MTEXT"))
    (prompt "\nSelected entity must be MTEXT! Try again...")
    (setq ent (car (entsel "\nSelect MTEXT:")))
    (princ)
    )
  
  (while (/= ent nil)
        
    (cond
      
      ;;1. cond
      ((/= (cdr (assoc 3 (entget ent))) nil)
       (setq txt1 (cdr (assoc 3 (entget ent)))
	     formatted_text1 (LM:UnFormat txt1 T)
	     formatted_text1 (vl-string-trim " " formatted_text1)
	     mtxt_height 2.50
	     )
       
       (if (/= (cdr (assoc 1 (entget ent))) nil)
	 (setq txt2 (cdr (assoc 1 (entget ent)))
	       formatted_text2 (LM:UnFormat txt2 T)
	       formatted_text2 (vl-string-trim " " formatted_text2)
	       )
	 )
       
       (if (/= formatted_text2 nil)
	 (setq new_txt (strcat formatted_text1 formatted_text2))
	 (setq new_txt (strcat formatted_text1))
	 )
       
       ;; match text with underline
       (if (or (wcmatch txt1 "*\\L*,*\\l*") (wcmatch txt2 "*\\L*,*\\l*"))
	 (setq underline_txt (strcat "{\\fiso3098b|b1|i0;""\\L" new_txt "\\l}") ;; "\\fiso3098b" is the name of the font (you can changed it), "|b1|" turn on Bold", "|i0|" turn off Italic",
	                                                                        ;; "\\L" turns underline on, "\\l" turns underline off
	       )
	 (setq underline_txt (strcat "{\\fiso3098b|b1|i0;" new_txt "}"))
	 )
       
       (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 (cdr (assoc 10 (entget ent)))) (cons 40 mtxt_height) (cons 41 (cdr (assoc 41 (entget ent))))
		      (cons 50 (cdr (assoc 50 (entget ent)))) (cons 71 7) (cons 72 1) (cons 7 "Standard") (cons 3 underline_txt)))
       (entdel ent)
       ) ;; end 1. cond
      
      ;;2. cond
      ((/= (cdr (assoc 1 (entget ent))) nil)
       (setq obj (vlax-ename->vla-object ent)
	     txt (cdr (assoc 1 (entget ent)))
	     )
       
       (cond
	 
	 ;; match text with paragraph
	 ((and (wcmatch txt "*\\P*") (not (wcmatch txt "*\\L*,*\\l*")))
	  (setq formatted_text (LM:UnFormat txt T)
		formatted_text (vl-string-trim " " formatted_text) ;; Remove spaces at the beginning and end of a string if it's occured
		mtxt_height 2.00
		)
	  
	  (setq val (vl-string-translate " " "\n" formatted_text)
	        new_txt (strcat "{\\fiso3098b|b1|i0;" val "}")) ;; "\\fiso3098b" is the name of the font (you can changed it), "|b1|" turn on Bold", "|i0|" turn off Italic",
	  
	  (entmod (subst (cons 1 new_txt) (cons 1 txt) (entget ent)))
	  (vlax-put-property obj 'StyleName "Standard") ;; Text Style is "Standard"
	  (vlax-put-property obj 'Height mtxt_height) ;; Put the Height from variable "mtxt_height"
	  )

	 ;; match text with underline
	 ((and (wcmatch txt "*\\L*,*\\l*") (not (wcmatch txt "*\\P*")))
	  (setq formatted_text (LM:UnFormat txt T)
		formatted_text (vl-string-trim " " formatted_text) ;; Remove spaces at the beginning and end of a string if it's occured
		mtxt_height 2.50
		)
	  
	  (setq underline_txt (strcat "{\\fiso3098b|b1|i0;""\\L" formatted_text "\\l}")) ;; "\\fiso3098b" is the name of the font (you can changed it), "|b1|" turn on Bold", "|i0|" turn off Italic",
	    						                                 ;; "\\L" turns underline on, "\\l" turns underline off
	  (entmod (subst (cons 1 underline_txt) (cons 1 txt) (entget ent)))
	  (vlax-put-property obj 'StyleName "Standard") ;; Text Style is "Standard"
	  (vlax-put-property obj 'Height mtxt_height) ;; Put the Height from variable "mtxt_height"
	  )

	 ;; match text with paragraph and underline
	 ((wcmatch txt "*\\P*,*\\L*,*\\l*")
	  (setq formatted_text (LM:UnFormat txt T)
		formatted_text (vl-string-trim " " formatted_text) ;; Remove spaces at the beginning and end of a string if it's occured
		mtxt_height 2.50
		)
	  
	  (setq val (vl-string-translate " " "\n" formatted_text)
	        underline_txt (strcat "{\\fiso3098b|b1|i0;""\\L" val "\\l}")) ;; "\\fiso3098b" is the name of the font (you can changed it), "|b1|" turn on Bold", "|i0|" turn off Italic",
	    						                      ;; "\\L" turns underline on, "\\l" turns underline off
	  (entmod (subst (cons 1 underline_txt) (cons 1 txt) (entget ent)))
	  (vlax-put-property obj 'StyleName "Standard") ;; Text Style is "Standard"
	  (vlax-put-property obj 'Height mtxt_height) ;; Put the Height from variable "mtxt_height"
	  )	 
	 ) ;;end cond with wcmatch
       
       ) ;; end 2. cond
      
      ) ;; end cond
    
    (prompt "\nTo finish execution press ESC!!!")
    (setq ent (car (entsel "\nSelect MTEXT:")))
    (while (or (= ent nil) (/= (cdr (assoc 0 (entget ent))) "MTEXT"))
      (prompt "\nSelected entity must be MTEXT! Try again...")
      (setq ent (car (entsel "\nSelect MTEXT:")))
      (princ)
      )
    )
  (setq mtxt_height nil ent nil obj nil txt nil txt1 nil txt2 nil formatted_text nil formatted_text1 nil formatted_text2 nil val nil new_txt nil underline_txt nil)
  (prompt "\nThe changes has been done!")
  (princ)
  )

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)

 

From this picture belowe I got this using CHMTXT. As you can see, it retains the text format, but from "Note" it will not, because it's not easy to formate it, except if you don't include some Delimiter (for e.g. ";"), then I can say, find ";" and substitue everywhere with "\n". Then I will get a formatted text from "Note" with desired output.

Capture.JPG.f4303c3afb60ab28c8f3528ccdc8aefc.JPG

 

Please try this modified code and let me know.

Best regards.

Edited by Saxlle
mjab8 Explorer

mjab8

Posted
  • Author
Posted

Hi Saxlle, do you mind to get your email? Mine is mikechin8@yahoo.com.au

Sent me an email if you can.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...