如何统一MTEXT的文字格式

ningyong58

在CAD中,有很多MTEXT的shx不一样,有txt.shx,有HZTXT.SHX,KHZTEX.SHX

如何将他们统一为hztx.shx

dianbotang

先建立字体为hztx.shx的文字样式，并应用到所有多行文字。

特性栏-文字-内容，如果多行文字带有复杂格式，可应用以下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