;;; Match Text and Mtext Height, Width & Oblique (Lee Mac Routine)
;;; Saved from here: http://www.cadtutor.net/forum/showthread.php?37230-Match-Text-Height-Width-amp-Oblique/page2

(defun c:mt (/ 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<>"))
(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.)))
(c:mt)