[VBA]cad多行文字控制符去除源代码
这是受之前的正则公式应用的启发，用vba把所有可能遇到的控制符进行了一个汇总，代码及操作基本能达到要求。需要的朋友们可以自己改为自己的一个函数'***********************************************
'功能：vba对多行文字控制符进行去除，本函数采用vb标准的字符对比，非正则公式
'函数名：getMTextUnformatString
'作者：cx
'***********************************************
Public Function GetMTextUnformatString(MTextString As String) As String
Dim s As String, st As String
Dim s1() As String, s2() As String
Dim i As Long, m As Long
m = 27
ReDim s1(0 To m) As String
ReDim s2(0 To m) As String
s1(0) = "\": s2(0) = "\x01"
s1(1) = "\{": s2(1) = "\x02"
s1(2) = "\}": s2(2) = "\x03"
s1(3) = "\f*;": s2(3) = ""
s1(4) = "\C*;": s2(4) = ""
s1(5) = "\H*;": s2(5) = ""
s1(6) = "\T*;": s2(6) = ""
s1(7) = "\Q*;": s2(7) = ""
s1(8) = "\W*;": s2(8) = ""
s1(9) = "\A*;": s2(9) = ""
s1(10) = "\p*;": s2(10) = ""
s1(11) = "\S^*;": s2(11) = "$3$1"
s1(12) = "\S*;": s2(12) = "$2$1"
s1(13) = "\S*^;": s2(13) = "$2$2"
s1(14) = "\P": s2(14) = vbCrLf
s1(15) = "\~": s2(15) = ""
s1(16) = "\L": s2(16) = ""
s1(17) = "\l": s2(17) = ""
s1(18) = "\O": s2(18) = ""
s1(19) = "\o": s2(19) = ""
s1(20) = "\K": s2(20) = ""
s1(21) = "\k": s2(21) = ""
s1(19) = "\o": s2(19) = ""
s1(20) = "\K": s2(20) = ""
s1(21) = "\k": s2(21) = ""
s1(22) = "{": s2(22) = ""
s1(23) = "^}": s2(23) = ""
s1(24) = "}": s2(24) = ""
s1(25) = "\x01": s2(25) = ""
s1(26) = "\x02": s2(26) = "{"
s1(27) = "\x03": s2(27) = "}"
'Dim RE As Object
'Set RE = ThisDrawing.Application.GetInterfaceObject("VBscript.RegExp")
'RE.IgnoreCase = True
'RE.Globa = True
Dim k As Long, k1 As Long
Dim SE As Variant
Dim st1 As String
s = MTextString: k1 = Len(s)
For i = 0 To m
Do
k = k1
st = StrMatch(s, s1(i))
If InStr(1, s2(i), "$") > 0 Then
SE = Split(s2(i), "$")
st1 = Mid(st, SE(1) + 1, Len(st) - SE(2) - SE(1))
Else
st1 = s2(i)
End If
If InStr(1, s, st) > 0 Then s = Replace(s, st, st1)
k1 = Len(s)
Loop Until k1 = k
'Debug.Print s
Next i
'Set RE = Nothing
GetMTextUnformatString = s
End Function
Private Function StrMatch(Str As String, ss As String)
'查str字符串中，匹配ss通配符的子串并返回
Dim s As String, st As String
s = "*?": st = ss
Dim i As Long, j As Long, k As Long
Dim aSt As Variant
For i = 1 To Len(s)
Select Case Mid(s, i, 1)
Case "*"
If InStr(1, ss, "*") > 0 Then
aSt = Split(ss, "*")
j = InStr(1, Str, aSt(0))
If j > 0 Then
st = Mid(Str, j, InStr(j, Str, aSt(1)) - j + 1)
End If
End If
Case "?"
If InStr(1, ss, "?") > 0 Then
aSt = Split(ss, "?")
j = InStr(1, Str, aSt(0))
If j > 0 Then
st = Mid(Str, j, InStr(j, Str, aSt(1)) - j + 1)
End If
End If
Case Else
End Select
Next i
StrMatch = st
End Function
Sub m2t()
Dim mt As AcadEntity
Dim pnt As Variant
Dim Str As String
ThisDrawing.Utility.GetEntity mt, pnt, "getMtext:"
Str = mt.TextString
'Debug.Print Str
Str = GetMTextUnformatString(Str)
MsgBox Str
End Sub
沙发先占上, 核心功能比较完善. 谢谢分享
页:
[1]