[原创]获取MText中的可用字符

雪山飞狐_lzh · 发表于 2004-6-24 21:33:00

本帖最后由作者于 2004-6-24 22:06:23 编辑

试试这个： {\C3;明经通{\fSimSun|b0|i0|c134|p2;道}\Lhttp://www.mjtd.com{\C3;明经通道\Lhtt\C1;p://www.mj\C3;td.com\l是一个好网站啊，呵呵}
\l是\Ftxt.shx,gbcbig.shx|c134;一个好网站啊，呵呵} 返回明经通道http://www.mjtd.com明经通道http://www.mjtd.com是一个好网站啊，呵呵是一个好网站啊，呵呵再一个 "{\C3;明经通{\fSimSun|b0|i0|c134|p2;道}\Lhttp://www.mjtd.com{\C3;明经通道\Lhttp{\C1;://{\C3;www}.mjtd.com}\l是一个好网站啊，呵呵}\l是{\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，呵呵}"

mccad · 发表于 2004-6-25 07:31:00

已经写出来了，试用中：

Sub MtToDt()
Dim s As String
's = ThisDrawing.ModelSpace(0).TextString
s = "{\C3;明经通{\fSimSun|b0|i0|c134|p2;道}\Lhttp://www.mjtd.com{\C3;明经通道\Lhttp{\C1;://{\C3;www}.mjtd.com}\l是一个好网站啊，呵呵}\l是{\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，呵呵}"
Debug.Print s
s = GetMTextUnformatString(s)
Debug.Print s
End Sub
Public Function GetMTextUnformatString(MTextString As String) As String
Dim s As String
Dim RE As RegExp
Set RE = New RegExp
RE.IgnoreCase = True
RE.Global = True
s = MTextString
'替换\\字符
RE.Pattern = "\\\"
s = RE.Replace(s, Chr(1))
'删除堆迭格式
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)"
s = RE.Replace(s, "")
'删除不间断空格格式
RE.Pattern = "\\~"
s = RE.Replace(s, " ")
'删除换行符格式
RE.Pattern = "\\P"
s = RE.Replace(s, "")
'删除{}
RE.Pattern = "({|})"
s = RE.Replace(s, "")
'替换回\\字符
RE.Pattern = "\x01"
s = RE.Replace(s, "\")
Set RE = Nothing
GetMTextUnformatString = s
End Function

Sub MtToDt()
       Dim s As String
       's = ThisDrawing.ModelSpace(0).TextString
       s = "{\C3;明经通{\fSimSun|b0|i0|c134|p2;道}\Lhttp://www.mjtd.com{\C3;明经通道\Lhttp{\C1;://{\C3;www}.mjtd.com}\l是一个好网站啊，呵呵}\l是{\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，呵呵}"
       Debug.Print s
       s = GetMTextUnformatString(s)
       Debug.Print s
       
End Sub
Public Function GetMTextUnformatString(MTextString As String) As String
       Dim s As String
       Dim RE As RegExp
       Set RE = New RegExp
       RE.IgnoreCase = True
       RE.Global = True
       s = MTextString
       '替换\\字符
       RE.Pattern = "\\\"
       s = RE.Replace(s, Chr(1))
       '删除堆迭格式
       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)"
       s = RE.Replace(s, "")
       '删除不间断空格格式
       RE.Pattern = "\\~"
       s = RE.Replace(s, " ")
       '删除换行符格式
       RE.Pattern = "\\P"
       s = RE.Replace(s, "")
       '删除{}
       RE.Pattern = "({|})"
       s = RE.Replace(s, "")
       '替换回\\字符
       RE.Pattern = "\x01"
       s = RE.Replace(s, "\")
       Set RE = Nothing
       GetMTextUnformatString = s
End Function

雪山飞狐_lzh · 发表于 2004-6-25 09:06:00

"{\C3;明经通{\fSimSun|b0|i0|c134|p2;道}\L\{http://www.mjtd.com\}{\C3;明经通道\Lhttp{\C1;://{\C3;www}.mjtd.com}\l是一个好网站啊，呵呵}\l是{\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，呵呵}"

这个例子不行，好像没有考虑 "\{"和"\}"

不过我的好像把"{}"都丢了

雪山飞狐_lzh · 发表于 2004-6-25 12:30:00

下面的是用栈实现的，

Public Function GetMTextUnformatString(ByVal str As String) As String
On Error Resume Next
Dim pStrs As New Collection
Dim pStrack As String
Dim n As Integer
Dim pStr As String
Dim pEnd As String
Do While Len(str) > 0
n = IIf(Left(str, 1) = "", 2, 1)
pStr = Left(str, n)
If pStr = "}" Then
pEnd = pStrs(pStrs.Count)
pStrack = ""
Do While pEnd <> "{"
pStrack = pEnd & pStrack
pStrs.Remove pStrs.Count
pEnd = pStrs(pStrs.Count)
Loop
pStrs.Remove pStrs.Count
pStrs.Add GetRtfStrig(pStrack)
Else
pStrs.Add Left(str, n)
End If
str = Right(str, Len(str) - n)
Loop
For Each i In pStrs
GetMTextUnformatString = GetMTextUnformatString & i
Next i
End Function
Private Function GetRtfStrig(ByVal str As String) As String
Dim s As String
Dim RE As RegExp
Set RE = New RegExp
RE.IgnoreCase = True
RE.Global = True
s = str
'替换\\字符
RE.Pattern = "\\\"
s = RE.Replace(s, Chr(1))
'删除堆迭格式
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)"
s = RE.Replace(s, "")
'删除不间断空格格式
RE.Pattern = "\\~"
s = RE.Replace(s, " ")
'删除换行符格式
RE.Pattern = "\\P"
s = RE.Replace(s, "")
'替换{}
RE.Pattern = "\\{"
s = RE.Replace(s, "{")
RE.Pattern = "\\}"
s = RE.Replace(s, "}")
'替换回\\字符
RE.Pattern = "\x01"
s = RE.Replace(s, "\")
Set RE = Nothing
GetRtfStrig = sEnd Function

Public Function GetMTextUnformatString(ByVal str As String) As String
On Error Resume Next
       Dim pStrs As New Collection
       Dim pStrack As String
       Dim n As Integer
       Dim pStr As String
       Dim pEnd As String
       Do While Len(str) > 0
               n = IIf(Left(str, 1) = "", 2, 1)
               pStr = Left(str, n)
               If pStr = "}" Then
                       pEnd = pStrs(pStrs.Count)
                       pStrack = ""
                       Do While pEnd <> "{"
                               pStrack = pEnd & pStrack
                               pStrs.Remove pStrs.Count
                               pEnd = pStrs(pStrs.Count)
                       Loop
                       pStrs.Remove pStrs.Count
                       pStrs.Add GetRtfStrig(pStrack)
               Else
                       pStrs.Add Left(str, n)
               End If
               str = Right(str, Len(str) - n)
       Loop
       For Each i In pStrs
               GetMTextUnformatString = GetMTextUnformatString & i
       Next i
End Function
Private Function GetRtfStrig(ByVal str As String) As String
       Dim s As String
       Dim RE As RegExp
       Set RE = New RegExp
       RE.IgnoreCase = True
       RE.Global = True
       s = str
       '替换\\字符
       RE.Pattern = "\\\"
       s = RE.Replace(s, Chr(1))
       '删除堆迭格式
       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)"
       s = RE.Replace(s, "")
       '删除不间断空格格式
       RE.Pattern = "\\~"
       s = RE.Replace(s, " ")
       '删除换行符格式
       RE.Pattern = "\\P"
       s = RE.Replace(s, "")
       '替换{}
       RE.Pattern = "\\{"
       s = RE.Replace(s, "{")
       RE.Pattern = "\\}"
       s = RE.Replace(s, "}")
       '替换回\\字符
       RE.Pattern = "\x01"
       s = RE.Replace(s, "\")
       Set RE = Nothing
       GetRtfStrig = sEnd Function

替换前："{\C3;\{明经通{\fSimSun|b0|i0|c134|p2;道\}}\Lhttp://www.mjtd.com{\C3;明经通道\Lhttp{\C1;://{\C3;www}.mjtd.com}\l是一个好网站啊，呵呵}\l是{\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，呵呵}"替换后：{明经通道}http://www.mjtd.com明经通道http://www.mjtd.com是一个好网站啊，呵呵是一个好网站啊，呵呵

mccad · 发表于 2004-6-25 12:37:00

Public Function GetMTextUnformatString(MTextString As String) As String
Dim s As String
Dim RE As RegExp
Set RE = New 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 = "\\S(.[^;]*)(\^|#|\\)(.[^;]*);"
s = RE.Replace(s, "$1$3")
'删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
RE.Pattern = "(

雪山飞狐_lzh · 发表于 2004-6-25 12:44:00

本帖最后由作者于 2004-6-25 20:57:51 编辑

如果故意挑点刺的话，下面的测试用例好像有点问题 s = "{\C3;\{明经通{\fSimSun|b0|i0|c134|p2;道\}}\Lhttp://www.mjtd.com{\C3;明经通道\Lhttp{\C1;://{\C3;www}.mjtd.com}\l是一个好网站啊，呵呵}\l是{\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，" & Chr(3) & "呵呵}"
不过我的代码好像也有点问题，改进中。。。

mccad · 发表于 2004-6-25 21:09:00

不错，是有问题，但实际是不可能出现的，因为该字符没有实际意义，通过用户的输入也不可能出现这样的字符，所以不需要考虑这种情况。

mccad · 发表于 2004-6-25 21:33:00

由于AutoCAD没有把分号做为识别符，所以用分号来堆迭会出现异常。所以这里没有把多行文字中的分号做特别处理。
应该说这个程序已经满足要求了。

雪山飞狐_lzh · 发表于 2004-6-25 23:32:00

本帖最后由作者于 2004-6-27 13:00:15 编辑

我又改进了一下，下面的程序基本可用。3楼的代码又重写了一遍

Public Function GetMTextUnformatString(ByVal str As String) As String
'程序功能:按给定的MText字符串返回可用的字符串
On Error Resume Next Dim pStrs As New Collection
Dim pStack As Collection
Dim n As Integer
Dim pStr As String
Dim pEnd As String
str = "{" & str & "}"
Do While Len(str) > 0
n = IIf(Left(str, 1) = "", 2, 1)
pStr = Left(str, n)
'分割MText字符串为控制字符或单个字符
If pStr = "}" Then
'遇"}"时出栈，直到"{"
pEnd = pStrs(pStrs.Count)
Set pStack = New Collection
pStack.Add "*TlsCad*"
Do While pEnd <> "{"
pStack.Add pEnd, , 1
pStrs.Remove pStrs.Count
pEnd = pStrs(pStrs.Count)
Loop
pStrs.Remove pStrs.Count
pStack.Remove pStack.Count
For Each i In GetRtfString(pStack)
'调用GetRtfString函数返回可用的字符集合
pStrs.Add i
Next i
Else
'当前字符入栈
pStrs.Add Left(str, n)
End If
str = Right(str, Len(str) - n)
Loop
For Each i In pStrs
'合并字符集合为字符串
If Len(i) = 2 Then
'处理\、{、}
GetMTextUnformatString = GetMTextUnformatString & Right(i, 1)
Else
GetMTextUnformatString = GetMTextUnformatString & i
End If
Next i
End FunctionPrivate Function GetRtfString(ByVal stack As Collection) As Collection
'程序功能:按给定的Rtf字符集合返回可用的字符集合 Dim pStrs As New Collection
Dim pStr As String, pType As Long
Dim i, j
For Each i In stack
If Len(i) = 1 Then
pStrs.Add i
ElseIf Len(i) = 2 Then
pType = Asc(UCase(Right(i, 1)))
Select Case pType
Case 85, 92, 123, 125
'\ or { or } or U
pStrs.Add i
Case 65, 67, 70, 72, 81, 84, 87
'A or C or F or H or Q or T or W
Do While stack(1) <> ";"
stack.Remove 1
Loop
stack.Remove 1
Case 76, 79, 80
'L or O or P
Case 83
'S
stack.Remove 1
Do While stack(1) <> ";"
If stack(1) <> "^" Then
pStrs.Add stack(1)
End If
stack.Remove 1
Loop
stack.Remove 1
Case 126
'~
pStrs.Add " "
End Select
End If
Next i Set GetRtfString = pStrs
End Function

Public Function GetMTextUnformatString(ByVal str As String) As String
'程序功能:按给定的MText字符串返回可用的字符串
On Error Resume Next       Dim pStrs As New Collection
       Dim pStack As Collection
       Dim n As Integer
       Dim pStr As String
       Dim pEnd As String
       
       str = "{" & str & "}"
       Do While Len(str) > 0
       
               n = IIf(Left(str, 1) = "", 2, 1)
               pStr = Left(str, n)
               '分割MText字符串为控制字符或单个字符
               
               If pStr = "}" Then
               '遇"}"时出栈，直到"{"
               
                       pEnd = pStrs(pStrs.Count)
                       Set pStack = New Collection
                       pStack.Add "*TlsCad*"
                       
                       Do While pEnd <> "{"
                               
                               pStack.Add pEnd, , 1
                               pStrs.Remove pStrs.Count
                               pEnd = pStrs(pStrs.Count)
                               
                       Loop
                       
                       pStrs.Remove pStrs.Count
                       pStack.Remove pStack.Count
                       
                       For Each i In GetRtfString(pStack)
                       '调用GetRtfString函数返回可用的字符集合
                       
                               pStrs.Add i
                               
                       Next i
                       
               Else
               '当前字符入栈
                       pStrs.Add Left(str, n)
                       
               End If
               
               str = Right(str, Len(str) - n)
               
       Loop
       
       For Each i In pStrs
       '合并字符集合为字符串
               If Len(i) = 2 Then
               '处理\、{、}
                       GetMTextUnformatString = GetMTextUnformatString & Right(i, 1)
                       
               Else
               
                       GetMTextUnformatString = GetMTextUnformatString & i
                       
               End If
               
       Next i
       
End FunctionPrivate Function GetRtfString(ByVal stack As Collection) As Collection
'程序功能:按给定的Rtf字符集合返回可用的字符集合       Dim pStrs As New Collection
       Dim pStr As String, pType As Long
       Dim i, j
       
       For Each i In stack
               
               If Len(i) = 1 Then
               
                       pStrs.Add i
                       
               ElseIf Len(i) = 2 Then
               
                       pType = Asc(UCase(Right(i, 1)))
                       
                       Select Case pType
                       
                       Case 85, 92, 123, 125
                       '\ or { or } or U
       
                               pStrs.Add i
                               
                       Case 65, 67, 70, 72, 81, 84, 87
                       'A or C or F or H or Q or T or W
                       
                               Do While stack(1) <> ";"
                                       stack.Remove 1
                               Loop
                               stack.Remove 1
                               
                       Case 76, 79, 80
                       'L or O or P
                       
                       Case 83
                       'S
                       
                               stack.Remove 1
                               Do While stack(1) <> ";"
                                       If stack(1) <> "^" Then
                                               pStrs.Add stack(1)
                                       End If
                                       stack.Remove 1
                               Loop
                               stack.Remove 1
                               
                       Case 126
                       '~
                       
                               pStrs.Add " "
                               
                       End Select
                       
               End If
       
       Next i       Set GetRtfString = pStrs
       
End Function

雪山飞狐_lzh · 发表于 2004-6-27 13:26:00

意犹未尽，再来段VB.Net的

'程序功能：返回MText中的可用字符串
Public Function GetMTextUnFormatString(ByVal str As String) As String
Dim pQueue As System.Collections.Queue
Dim pSubStack As System.Collections.Stack
Dim pStack As New System.Collections.Stack
Dim pNum As Short
Dim pStr, i As String
Try
str = "{" & str & "}"
'将MText字符串分割为控制符和单个字符
Do While str.Length > 0
pNum = IIf(str.Substring(0, 1) = "", 2, 1)
'当前字符为"}"时顺序出栈，直到遇到第一个"{"
If pNum = 1 And str.Substring(0, 1) = "}" Then
pSubStack = New System.Collections.Stack
Do While Convert.ToString(pStack.Peek()) <> "{"
pSubStack.Push(pStack.Pop())
Loop
pStack.Pop()
'调用GetRtfTextUnFormatString函数返回Rtf字符栈中的可用字符队列
pQueue = GetRtfTextUnFormatString(pSubStack)
'将可用字符队列顺序入栈
Do While pQueue.Count > 0
pStack.Push(pQueue.Dequeue)
Loop
Else
'当前字符入栈
pStack.Push(str.Substring(0, pNum))
End If
str = str.Substring(pNum)
Loop '返回栈中的可用字符串
For Each i In pStack.ToArray
If i.Length = 1 Then
pStr = i & pStr
ElseIf i.Length = 2 Then
pStr = i.Substring(1, 1) & pStr
End If
Next i
Return pStr
Catch ex As Exception
Return ""
End Try End Function '程序功能：返回Rtf字符栈中的可用字符队列
Private Function GetRtfTextUnFormatString(ByVal stack As System.Collections.Stack) As System.Collections.Queue
Dim i As Object
Dim pStr As String
Dim pQueue As New System.Collections.Queue
Try
'顺序出栈
Do While stack.Count > 0
pStr = Convert.ToString(stack.Pop)
'当前的单个字符入队
If pStr.Length = 1 Then
pQueue.Enqueue(pStr)
Else
'处理控制字符
Select Case pStr.Substring(1, 1).ToUpper
Case "", "{", "}", "U"
pQueue.Enqueue(pStr)
Case "A", "C", "F", "H", "Q", "T", "W"
Do While Convert.ToString(stack.Pop()) <> ";"
Loop
Case "L", "O", "P"
Case "S"
Do While Convert.ToString(stack.Peek()) <> ";"
If stack.Peek <> "^" Then
pQueue.Enqueue(stack.Pop())
Else
stack.Pop()
End If
Loop
stack.Pop()
Case "~"
pQueue.Enqueue(" ")
End Select
End If
Loop
Catch ex As Exception
End Try
Return pQueue
End Function

'程序功能：返回MText中的可用字符串
       Public Function GetMTextUnFormatString(ByVal str As String) As String
               Dim pQueue As System.Collections.Queue
               Dim pSubStack As System.Collections.Stack
               Dim pStack As New System.Collections.Stack
               Dim pNum As Short
               Dim pStr, i As String
               Try
                       str = "{" & str & "}"
                       '将MText字符串分割为控制符和单个字符
                       Do While str.Length > 0
                               pNum = IIf(str.Substring(0, 1) = "", 2, 1)
                               '当前字符为"}"时顺序出栈，直到遇到第一个"{"
                               If pNum = 1 And str.Substring(0, 1) = "}" Then
                                       pSubStack = New System.Collections.Stack
                                       Do While Convert.ToString(pStack.Peek()) <> "{"
                                               pSubStack.Push(pStack.Pop())
                                       Loop
                                       pStack.Pop()
                                       '调用GetRtfTextUnFormatString函数返回Rtf字符栈中的可用字符队列
                                       pQueue = GetRtfTextUnFormatString(pSubStack)
                                       '将可用字符队列顺序入栈
                                       Do While pQueue.Count > 0
                                               pStack.Push(pQueue.Dequeue)
                                       Loop
                               Else
                                       '当前字符入栈
                                       pStack.Push(str.Substring(0, pNum))
                               End If
                               str = str.Substring(pNum)
                       Loop                       '返回栈中的可用字符串
                       For Each i In pStack.ToArray
                               If i.Length = 1 Then
                                       pStr = i & pStr
                               ElseIf i.Length = 2 Then
                                       pStr = i.Substring(1, 1) & pStr
                               End If
                       Next i
                       Return pStr
               Catch ex As Exception
                       Return ""
               End Try       End Function       '程序功能：返回Rtf字符栈中的可用字符队列
       Private Function GetRtfTextUnFormatString(ByVal stack As System.Collections.Stack) As System.Collections.Queue
               Dim i As Object
               Dim pStr As String
               Dim pQueue As New System.Collections.Queue
               Try
                       '顺序出栈
                       Do While stack.Count > 0
                               pStr = Convert.ToString(stack.Pop)
                               '当前的单个字符入队
                               If pStr.Length = 1 Then
                                       pQueue.Enqueue(pStr)
                               Else
                                       '处理控制字符
                                       Select Case pStr.Substring(1, 1).ToUpper
                                               Case "", "{", "}", "U"
                                                       pQueue.Enqueue(pStr)
                                               Case "A", "C", "F", "H", "Q", "T", "W"
                                                       Do While Convert.ToString(stack.Pop()) <> ";"
                                                       Loop
                                               Case "L", "O", "P"
                                               Case "S"
                                                       Do While Convert.ToString(stack.Peek()) <> ";"
                                                               If stack.Peek <> "^" Then
                                                                       pQueue.Enqueue(stack.Pop())
                                                               Else
                                                                       stack.Pop()
                                                               End If
                                                       Loop
                                                       stack.Pop()
                                               Case "~"
                                                       pQueue.Enqueue(" ")
                                       End Select
                               End If
                       Loop
               Catch ex As Exception
               End Try
               Return pQueue
       End Function

账号		自动登录	找回密码
密码			注册