请高手帮我编个修改字体的CAD宏

这个问题也是困扰我好久的问题，现在终于有了完整的解决方案。以下是vba程序。
Option Explicit

'提取和替换多行文字内容
Public Sub GetAndReplaceMTextString()
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.PickfirstSelectionSet
If SSet.Count = 0 Then
MsgBox "未选择对象"
Exit Sub
End If
Dim objMText As AcadEntity
Dim ptMin As Variant, ptMax As Variant
Dim ptCenter(0 To 2) As Double
Dim radius As Double
For Each objMText In SSet
If TypeOf objMText Is AcadMText Then
objMText.TextString = GetMTextUnformatString(objMText.TextString)
End If
Next
ThisDrawing.Regen True
End Sub

Public Function GetMTextUnformatString(MTextString As String) As String
Dim s As String
Dim RE As Object
' 获取Regular Expressions组件
Set RE = ThisDrawing.Application.GetInterfaceObject("Vbscript.RegExp")
' 忽略大小写
RE.IgnoreCase = True
' 搜索整个字符串
RE.Global = True
s = MTextString

'替换\\字符
RE.Pattern = "\\\\"
s = RE.Replace(s, Chr(1))
'替换\{字符
RE.Pattern = "\\{"
s = RE.Replace(s, Chr(2))
'替换\}字符
RE.Pattern = "\\}"
s = RE.Replace(s, Chr(3))

'删除段落缩进格式
RE.Pattern = "\\pi(.[^;]*);"
s = RE.Replace(s, "")
'删除制表符格式
RE.Pattern = "\\pt(.[^;]*);"
s = RE.Replace(s, "")
'删除堆迭格式
RE.Pattern = "\\S(.[^;]*)(\^|#|\\)(.[^;]*);"
s = RE.Replace(s, "$1$3")
'删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
RE.Pattern = "(\\F|\\C|\\H|\\T|\\Q|\\W|\\A)(.[^;]*);"
s = RE.Replace(s, "")
'删除下划线、删除线格式
RE.Pattern = "(\\L|\\O|\\l|\\o)"
s = RE.Replace(s, "")
'删除不间断空格格式
RE.Pattern = "\\~"
s = RE.Replace(s, " ")
'删除换行符格式
RE.Pattern = "\\P"
s = RE.Replace(s, "")
'删除换行符格式(针对Shift+Enter格式)
RE.Pattern = vbLf
s = RE.Replace(s, "")
'删除{}
RE.Pattern = "({|})"
s = RE.Replace(s, "")

'替换回\\,\{,\}字符
RE.Pattern = "\x01"
s = RE.Replace(s, "\")
RE.Pattern = "\x02"
s = RE.Replace(s, "{")
RE.Pattern = "\x03"
s = RE.Replace(s, "}")

Set RE = Nothing

GetMTextUnformatString = s
End Function