我经常要遇到一张图子的的多行文字字体设为中文后(如宋体),无法统一改为CAD系统子体。手工修改只能一组组修改,很烦,若能像Excel一样用宏做重复的工作,那就简单了。附操作过程录修(中间选择文字过程不明显)
我经常要遇到一张图子的的多行文字字体设为中文后(如宋体),无法统一改为CAD系统子体。手工修改只能一组组修改,很烦,若能像Excel一样用宏做重复的工作,那就简单了。附操作过程录修(中间选择文字过程不明显)
2楼
这个问题也是困扰我好久的问题,现在终于有了完整的解决方案。以下是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
回复