Jump to content

Match Text Height, Width & Oblique


VisDak

Recommended Posts

Hi All,

 

Please help me regarding that when im using match properties to match the Width, Height or Oblique of Mtext and Attributes it will not change or match the text i want,

 

Please provide me some route that will match the fonts Style,Effects and sizes of multitext or attribute :wink:

 

Thank you all

Link to comment
Share on other sites

Match Properties should be able to accomplish this task - make sure that Text is ticked in the Match Properties Settings.

 

Please provide me some route that will match the fonts Style,Effects and sizes of multitext or attribute...

This is not a LISP Supermarket - but more a help and advice site.

Link to comment
Share on other sites

Yes Lee,

 

its all ticked and the Text are checked on Match Properties Settings, i dont understand also, i also used the 2009 version same situation maybe the text width and oblique aré not included in Match properties,

 

see image,

 

Thanks lee,

MA settings.jpg

Link to comment
Share on other sites

I was experimenting with different ways to code this type of program, and with the advice of some of the guys over at the Swamp, this is what I came up with:

 

(defun c:mtxt (/ tEnt tObj ss)
 (vl-load-com)
 (if (and (setq tEnt (car (entsel "\nSelect Source Text: ")))
          (wcmatch (cdadr (entget tEnt)) "ATT*,*TEXT")
          (setq tObj (vlax-ename->vla-object tEnt)))
   (while (setq ss (ssget '((0 . "*TEXT,ATT*"))))
     (foreach Obj (mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                      (mapcar 'cadr (ssnamex ss))))
       (foreach fun '(Layer Color Height ObliqueAngle ScaleFactor StyleName)
         (if (and (vlax-property-available-p tObj fun)
                  (vlax-property-available-p Obj fun t))
           (vlax-put-property Obj fun
             (vlax-get-property tObj fun))))))
   (princ "\n<< Nothing Selected >>"))
 (princ))

Link to comment
Share on other sites

Hi All,

 

Good Day to all, i have here a Lisp route the will modify all the text width factor but only works on Dtext, not applicable on Mtext and Attribute,:glare:

 

Kindly Please arrange this code so that it will be used also on Mtext attributes and Dimensions, thanks all:roll:

 

(defun c:chw (/ ennyi23 wb23 shell23 loui23 el23)
(initget 7)
(prompt "\nSelect text(s).... ")
 (command "select" "au" pause)
 (setq ennyi23 (ssget "p"))
 (setvar "cmdecho" 0)
 (initget 7)
 (setq wb23 (getdist "\nEnter New Width Factor: "))
 (setq shell23 (sslength ennyi23))
 (prompt "\nChanging width of selected texts... stand by.")
 (command "undo" "mark")
 (setq loui23 0)
     (while (< loui23 shell23)
       (setq el23 (entget (ssname ennyi23 loui23)))
       (if (= "TEXT" (cdr (assoc 0 el23)))
         (progn
           (setq el23 (subst (cons 41 wb23) (assoc 41 el23) el23))
           (entmod el23)
         )
       )
       (setq loui23 (1+ loui23))
     )
 (setvar "cmdecho" 1)
 (princ)
)

Link to comment
Share on other sites

Thank Lee,

 

the code is work on Dtext , on Mtxt and Att, are not, but i like it is a dynamic match text properties, :roll:

 

(Layer Color Height ObliqueAngle ScaleFactor StyleName) this will be great when this route are also applicalbe on Mtxt and Att.

 

many thanks Lee,

Link to comment
Share on other sites

Thank Lee,

 

the code is work on Dtext , on Mtxt and Att, are not, but i like it is a dynamic match text properties, :roll:

 

(Layer Color Height ObliqueAngle ScaleFactor StyleName) this will be great when this route are also applicalbe on Mtxt and Att.

 

many thanks Lee,

 

MTEXT is difficult as the formatting is achieved through the TextString, and not by separate properties.

Link to comment
Share on other sites

Try this one - source cannot be MTEXT.

 

(defun c:mtxt (/ tEnt tObj ss)
 (vl-load-com)
 (if (and (setq tEnt (car (nentsel "\nSelect Source Text: ")))
          (wcmatch (cdadr (entget tEnt)) "ATT*,TEXT")
          (setq tObj (vlax-ename->vla-object tEnt)))
   (while (setq Obj (car (nentsel "\nSelect Destination Object: ")))
     (setq Obj (vlax-ename->vla-object Obj))
     (cond ((vl-position (vla-get-ObjectName Obj)
              '("AcDbAttribute" "AcDbText" "AcDbMText"))
            (foreach fun '(Layer Color Height ObliqueAngle ScaleFactor StyleName)
              (if (and (vlax-property-available-p tObj fun)
                       (vlax-property-available-p Obj fun t))
                (vlax-put-property Obj fun
                  (vlax-get-property tObj fun))))
           (if (eq (vla-get-ObjectName Obj) "AcDbMText")
            (vla-put-TextString Obj
              (strcat "{\\Q"
                (rtos (rtd (vla-get-ObliqueAngle tObj))) ";\\W"
                  (rtos (vla-get-ScaleFactor tObj)) ";"
                    (mip_mtext_unformat (vla-get-TextString Obj)) "}"))))
           (t (princ "\nMissed, Try Again..."))))                   
   (princ "\n<< Nothing Selected >>"))
 (princ))

(defun mip_MTEXT_Unformat ( Mtext / text Str )
 (setq Text "")
  (while (/= Mtext "")
       (cond
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
           (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
         ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
      (setq Mtext (substr Mtext 3)))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
     ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ")  ;;;Add by KPblC
      (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext)))))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
           (if (or
          (zerop (strlen Text))
          (= " " (substr Text (strlen Text)))
          (= " " (substr Mtext 3 1)))
              (setq Mtext (substr Mtext 3))
              (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
     ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
           (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                 Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                 Mtext (substr Mtext (+ 4 (strlen Str)))))
     (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
 Text)

(defun rtd (x)
 (* 180. (/ x pi)))

Link to comment
Share on other sites

As an upgrade, this can match MTEXT to MTEXT and DTEXT/ATTRIB* to MTEXT.

 

Only thing left is MTEXT -> DTEXT/ATTRIB* (the hardest one :( )

 

(defun c:mtxt (/ tEnt tObj ss)
 (vl-load-com)
 (if (and (setq tEnt (car (nentsel "\nSelect Source Text: ")))
          (wcmatch (cdadr (entget tEnt)) "ATT*,*TEXT")
          (setq tObj (vlax-ename->vla-object tEnt)))
   (while (setq Obj (car (nentsel "\nSelect Destination Object: ")))
     (setq Obj (vlax-ename->vla-object Obj))
     (cond ((vl-position (vla-get-ObjectName Obj)
              '("AcDbAttribute" "AcDbAttributeDefinition" "AcDbText" "AcDbMText"))
            (foreach fun '(Layer Color Height ObliqueAngle ScaleFactor StyleName)
              (if (and (vlax-property-available-p tObj fun)
                       (vlax-property-available-p Obj fun t))
                (vlax-put-property Obj fun
                  (vlax-get-property tObj fun))))
            (cond ((and (eq (vla-get-ObjectName Obj) "AcDbMText")
                        (vl-position (vla-get-ObjectName tObj)
                          '("AcDbAttributeDefinition" "AcDbAttribute" "AcDbText")))
                   (vla-put-TextString Obj
                     (strcat "{\\Q"
                       (rtos (rtd (vla-get-ObliqueAngle tObj))) ";\\W"
                         (rtos (vla-get-ScaleFactor tObj)) ";"
                           (mip_mtext_unformat (vla-get-TextString Obj)) "}")))
                  ((= (vla-get-ObjectName Obj) (vla-get-ObjectName tObj) "AcDbMText")
                   (vla-put-TextString Obj
                     (vl-String-Subst
                       (mip_mtext_unformat
                         (vla-get-TextString Obj))
                           (mip_mtext_unformat
                             (vla-get-TextString tObj))
                               (vla-get-TextString tObj))))))
           (t (princ "\nMissed, Try Again..."))))                   
   (princ "\n<< Nothing Selected >>"))
 (princ))

(defun mip_MTEXT_Unformat ( Mtext / text Str )
 (setq Text "")
  (while (/= Mtext "")
       (cond
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
           (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
         ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
      (setq Mtext (substr Mtext 3)))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
     ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ")  ;;;Add by KPblC
      (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext)))))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
           (if (or
          (zerop (strlen Text))
          (= " " (substr Text (strlen Text)))
          (= " " (substr Mtext 3 1)))
              (setq Mtext (substr Mtext 3))
              (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
     ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
           (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                 Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                 Mtext (substr Mtext (+ 4 (strlen Str)))))
     (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
 Text)

(defun rtd (x)
 (* 180. (/ x pi)))

Link to comment
Share on other sites

Thank Lee,

 

Yes it works i'll be using Dtext source, to match destinations of Mtxt and attributes, Great Lee:lol:

 

Cheers

Link to comment
Share on other sites

Thank Lee,

 

Yes it works i'll be using Dtext source, to match destinations of Mtxt and attributes, Great Lee:lol:

 

Cheers

 

I'm still going to work on MTEXT -> DTEXT match, just for completeness.

Link to comment
Share on other sites

Hopefully this should convert MTEXT--> DTEXT on Obliquing Angle and Width.

 

(defun c:mtxt (/ tEnt tObj ss tStr p1 p2)
 (vl-load-com)
 (if (and (setq tEnt (car (nentsel "\nSelect Source Text: ")))
          (wcmatch (cdadr (entget tEnt)) "ATT*,*TEXT")
          (setq tObj (vlax-ename->vla-object tEnt)))
   (while (setq Obj (car (nentsel "\nSelect Destination Object: ")))
     (setq Obj (vlax-ename->vla-object Obj))
     (cond ((vl-position (vla-get-ObjectName Obj)
              '("AcDbAttribute" "AcDbAttributeDefinition" "AcDbText" "AcDbMText"))
            (foreach fun '(Layer Color Height ObliqueAngle ScaleFactor StyleName)
              (if (and (vlax-property-available-p tObj fun)
                       (vlax-property-available-p Obj fun t))
                (vlax-put-property Obj fun
                  (vlax-get-property tObj fun))))
            (cond ((and (eq (vla-get-ObjectName Obj) "AcDbMText")
                        (vl-position (vla-get-ObjectName tObj)
                          '("AcDbAttributeDefinition" "AcDbAttribute" "AcDbText")))
                   (vla-put-TextString Obj
                     (strcat "{\\Q"
                       (rtos (rtd (vla-get-ObliqueAngle tObj))) ";\\W"
                         (rtos (vla-get-ScaleFactor tObj)) ";"
                           (mip_mtext_unformat (vla-get-TextString Obj)) "}")))
                  ((= (vla-get-ObjectName Obj) (vla-get-ObjectName tObj) "AcDbMText")
                   (vla-put-TextString Obj
                     (vl-String-Subst
                       (mip_mtext_unformat
                         (vla-get-TextString Obj))
                           (mip_mtext_unformat
                             (vla-get-TextString tObj))
                               (vla-get-TextString tObj))))
                  ((and (eq (vla-get-ObjectName tObj) "AcDbMText")
                        (vl-position (vla-get-ObjectName Obj)
                          '("AcDbAttributeDefinition" "AcDbAttribute" "AcDbText")))
                   (setq tStr (vla-get-TextString tObj))
                   (while
                     (progn
                       (cond ((and (setq p1 (vl-string-search "\\Q" tStr))
                                   (setq p2 (vl-string-position 59 tStr (+ p1 2))))
                              (vla-put-ObliqueAngle Obj
                                (dtr (distof (substr tStr (+ p1 3) (- p2 (+ p1 2))))))
                              (setq tStr (substr tStr (1+ p2))) t)
                             ((and (setq p1 (vl-string-search "\\W" tStr))
                                   (setq p2 (vl-string-position 59 tStr (+ p1 2))))                                          
                              (vla-put-ScaleFactor Obj
                                (distof (substr tStr (+ p1 3) (- p2 (+ p1 2)))))
                              (setq tStr (substr tStr (1+ p2))) t)
                             (t nil)))))))
           (t (princ "\nMissed, Try Again..."))))                   
   (princ "\n<< Nothing Selected >>"))
 (princ))

(defun mip_MTEXT_Unformat ( Mtext / text Str )
 (setq Text "")
  (while (/= Mtext "")
       (cond
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
           (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
         ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
      (setq Mtext (substr Mtext 3)))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
     ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ")  ;;;Add by KPblC
      (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext)))))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
           (if (or
          (zerop (strlen Text))
          (= " " (substr Text (strlen Text)))
          (= " " (substr Mtext 3 1)))
              (setq Mtext (substr Mtext 3))
              (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
     ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
           (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                 Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                 Mtext (substr Mtext (+ 4 (strlen Str)))))
     (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
 Text)

(defun rtd (x)
 (* 180. (/ x pi)))

(defun dtr (x)
 (* pi (/ x 180.)))

Link to comment
Share on other sites

  • 5 years later...
  • 2 months later...

Your Mtext defaults are all based on your styles. Change the style attributes for the text you want to update and it update all text with that style. Otherwise creat a new mtext with a new style (st command allows you to create/ edit styles) and use MA (match Properties) from that one.

Link to comment
Share on other sites

  • 2 years later...

found this post while doing a search to match attributes tag text font with another attributes tag text font of another layer.

It matches the font however it change the layer also. Possible to match the properties but exclude the layer?

 

Hopefully this should convert MTEXT--> DTEXT on Obliquing Angle and Width.

 

(defun c:mtxt (/ tEnt tObj ss tStr p1 p2)
 (vl-load-com)
 (if (and (setq tEnt (car (nentsel "\nSelect Source Text: ")))
          (wcmatch (cdadr (entget tEnt)) "ATT*,*TEXT")
          (setq tObj (vlax-ename->vla-object tEnt)))
   (while (setq Obj (car (nentsel "\nSelect Destination Object: ")))
     (setq Obj (vlax-ename->vla-object Obj))
     (cond ((vl-position (vla-get-ObjectName Obj)
              '("AcDbAttribute" "AcDbAttributeDefinition" "AcDbText" "AcDbMText"))
            (foreach fun '(Layer Color Height ObliqueAngle ScaleFactor StyleName)
              (if (and (vlax-property-available-p tObj fun)
                       (vlax-property-available-p Obj fun t))
                (vlax-put-property Obj fun
                  (vlax-get-property tObj fun))))
            (cond ((and (eq (vla-get-ObjectName Obj) "AcDbMText")
                        (vl-position (vla-get-ObjectName tObj)
                          '("AcDbAttributeDefinition" "AcDbAttribute" "AcDbText")))
                   (vla-put-TextString Obj
                     (strcat "{\\Q"
                       (rtos (rtd (vla-get-ObliqueAngle tObj))) ";\\W"
                         (rtos (vla-get-ScaleFactor tObj)) ";"
                           (mip_mtext_unformat (vla-get-TextString Obj)) "}")))
                  ((= (vla-get-ObjectName Obj) (vla-get-ObjectName tObj) "AcDbMText")
                   (vla-put-TextString Obj
                     (vl-String-Subst
                       (mip_mtext_unformat
                         (vla-get-TextString Obj))
                           (mip_mtext_unformat
                             (vla-get-TextString tObj))
                               (vla-get-TextString tObj))))
                  ((and (eq (vla-get-ObjectName tObj) "AcDbMText")
                        (vl-position (vla-get-ObjectName Obj)
                          '("AcDbAttributeDefinition" "AcDbAttribute" "AcDbText")))
                   (setq tStr (vla-get-TextString tObj))
                   (while
                     (progn
                       (cond ((and (setq p1 (vl-string-search "\\Q" tStr))
                                   (setq p2 (vl-string-position 59 tStr (+ p1 2))))
                              (vla-put-ObliqueAngle Obj
                                (dtr (distof (substr tStr (+ p1 3) (- p2 (+ p1 2))))))
                              (setq tStr (substr tStr (1+ p2))) t)
                             ((and (setq p1 (vl-string-search "\\W" tStr))
                                   (setq p2 (vl-string-position 59 tStr (+ p1 2))))                                          
                              (vla-put-ScaleFactor Obj
                                (distof (substr tStr (+ p1 3) (- p2 (+ p1 2)))))
                              (setq tStr (substr tStr (1+ p2))) t)
                             (t nil)))))))
           (t (princ "\nMissed, Try Again..."))))                   
   (princ "\n<< Nothing Selected >>"))
 (princ))

(defun mip_MTEXT_Unformat ( Mtext / text Str )
 (setq Text "")
  (while (/= Mtext "")
       (cond
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
           (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
         ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
      (setq Mtext (substr Mtext 3)))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
     ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ")  ;;;Add by KPblC
      (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext)))))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
           (if (or
          (zerop (strlen Text))
          (= " " (substr Text (strlen Text)))
          (= " " (substr Mtext 3 1)))
              (setq Mtext (substr Mtext 3))
              (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
     ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
           (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                 Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                 Mtext (substr Mtext (+ 4 (strlen Str)))))
     (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
 Text)

(defun rtd (x)
 (* 180. (/ x pi)))

(defun dtr (x)
 (* pi (/ x 180.)))

Link to comment
Share on other sites

found this post while doing a search to match attributes tag text font with another attributes tag text font of another layer.

It matches the font however it change the layer also. Possible to match the properties but exclude the layer?

 

realized that when matching text with attributes or vise versa, layer will retain. Only when between matching mtext with attributes or text then layer will follow mtext.

Link to comment
Share on other sites

  • 4 years later...

Hi, is it possible to match just text size (I want to keep current font, color, angle and everything else)?

 

 

 

On 6/16/2009 at 4:20 AM, Lee Mac said:

Hopefully this should convert MTEXT--> DTEXT on Obliquing Angle and Width.

 

 


(defun c:mtxt (/ tEnt tObj ss tStr p1 p2)
 (vl-load-com)
 (if (and (setq tEnt (car (nentsel "\nSelect Source Text: ")))
          (wcmatch (cdadr (entget tEnt)) "ATT*,*TEXT")
          (setq tObj (vlax-ename->vla-object tEnt)))
   (while (setq Obj (car (nentsel "\nSelect Destination Object: ")))
     (setq Obj (vlax-ename->vla-object Obj))
     (cond ((vl-position (vla-get-ObjectName Obj)
              '("AcDbAttribute" "AcDbAttributeDefinition" "AcDbText" "AcDbMText"))
            (foreach fun '(Layer Color Height ObliqueAngle ScaleFactor StyleName)
              (if (and (vlax-property-available-p tObj fun)
                       (vlax-property-available-p Obj fun t))
                (vlax-put-property Obj fun
                  (vlax-get-property tObj fun))))
            (cond ((and (eq (vla-get-ObjectName Obj) "AcDbMText")
                        (vl-position (vla-get-ObjectName tObj)
                          '("AcDbAttributeDefinition" "AcDbAttribute" "AcDbText")))
                   (vla-put-TextString Obj
                     (strcat "{\\Q"
                       (rtos (rtd (vla-get-ObliqueAngle tObj))) ";\\W"
                         (rtos (vla-get-ScaleFactor tObj)) ";"
                           (mip_mtext_unformat (vla-get-TextString Obj)) "}")))
                  ((= (vla-get-ObjectName Obj) (vla-get-ObjectName tObj) "AcDbMText")
                   (vla-put-TextString Obj
                     (vl-String-Subst
                       (mip_mtext_unformat
                         (vla-get-TextString Obj))
                           (mip_mtext_unformat
                             (vla-get-TextString tObj))
                               (vla-get-TextString tObj))))
                  ((and (eq (vla-get-ObjectName tObj) "AcDbMText")
                        (vl-position (vla-get-ObjectName Obj)
                          '("AcDbAttributeDefinition" "AcDbAttribute" "AcDbText")))
                   (setq tStr (vla-get-TextString tObj))
                   (while
                     (progn
                       (cond ((and (setq p1 (vl-string-search "\\Q" tStr))
                                   (setq p2 (vl-string-position 59 tStr (+ p1 2))))
                              (vla-put-ObliqueAngle Obj
                                (dtr (distof (substr tStr (+ p1 3) (- p2 (+ p1 2))))))
                              (setq tStr (substr tStr (1+ p2))) t)
                             ((and (setq p1 (vl-string-search "\\W" tStr))
                                   (setq p2 (vl-string-position 59 tStr (+ p1 2))))                                          
                              (vla-put-ScaleFactor Obj
                                (distof (substr tStr (+ p1 3) (- p2 (+ p1 2)))))
                              (setq tStr (substr tStr (1+ p2))) t)
                             (t nil)))))))
           (t (princ "\nMissed, Try Again..."))))                   
   (princ "\n<< Nothing Selected >>"))
 (princ))

(defun mip_MTEXT_Unformat ( Mtext / text Str )
 (setq Text "")
  (while (/= Mtext "")
       (cond
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
           (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
         ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
      (setq Mtext (substr Mtext 3)))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
     ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ")  ;;;Add by KPblC
      (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext)))))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
           (if (or
          (zerop (strlen Text))
          (= " " (substr Text (strlen Text)))
          (= " " (substr Mtext 3 1)))
              (setq Mtext (substr Mtext 3))
              (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
     ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
           (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                 Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                 Mtext (substr Mtext (+ 4 (strlen Str)))))
     (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
 Text)

(defun rtd (x)
 (* 180. (/ x pi)))

(defun dtr (x)
 (* pi (/ x 180.)))
 

 

 

Link to comment
Share on other sites

For what it is worth, and for just matching text size, I would be tempted to use the 'properties' dialogue to get the size from the donor text and then select the modified text (s) and manually change that using the properties dialogue box, though this would of course depend on how many texts you want to change and if they all go to the same size (use properties) or if you have many sizes (and a LISP might be quicker)

Link to comment
Share on other sites

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.

×
×
  • Create New...