代码改变世界

AutoCAD VBA提取多行文字内容

2011-03-19 17:01  精诚所至 金石为开  阅读(3347)  评论(0编辑  收藏  举报

AutoCAD VBA,提取多行文字内容,代码如下。

Public Function GetMTextUnformatString(MTextString As String) As String
Dim s As String
Dim RE As Object
Set RE = ThisDrawing.Application.GetInterfaceObject("VBscript.RegExp")
RE.IgnoreCase = True
RE.Globa = 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 = "\\~"
s = RE.Replace(s, "")
RE.pattern = "\\P"
s = RE.Replace(s, "")
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
Public Sub GetMTextString()
Dim objMText As AcadMText
Dim ptPick As Variant
ThisDrawing.Utility.GetEntity objMText, ptPick
MsgBox GetMTextUnformatString(objMText.TextString)
End Sub

代码完。