清除CAD多行文字所有格式-（VBA）

fangmin723

2. Private Sub SelectAllText(ByVal App As Object, objSset As Object, Optional ByVal strSsetname As String = "SELECTION~TEXT~1111")
   
3.     On Error GoTo err1
   
4.     Dim flag As Boolean
   
5.     flag = False
   
6.     For Each objSset In App.SelectionSets
   
7.         If objSset.Name = strSsetname Then
   
8.             flag = True
   
9.             Exit For
   
10.         End If
    
11.     Next
    
12.     If flag Then objSset.Delete      '创建集合，如集存在，则删除，再新建
    
13.     Set objSset = App.SelectionSets.Add(strSsetname)
    
14.     Dim gpCode(0) As Integer
    
15.     Dim dataValue(0) As Variant
    
16.     gpCode(0) = 0
    
17.     dataValue(0) = "text,mtext"
    
18.     Dim groupCode As Variant, dataCode As Variant
    
19.     groupCode = gpCode
    
20.     dataCode = dataValue
    
21.     objSset.SelectOnScreen groupCode, dataCode
    
22.     Exit Sub
    
23. err1:
    
24.     Debug.Print Err.Description
    
25.     Err.Clear
    
26. End Sub
    
27. 
    
28. Sub TT()
    
29.     Dim tstr As String, objSset As Object, objtrans As Object, reg As RegExp, objEntArr As New Collection, i As Integer, j As Integer
    
30.     Set Acdoc = AcadApplication.ActiveDocument
    
31.     SelectAllText Acdoc, objSset
    
32.     Set reg = CreateObject("Vbscript.RegExp")
    
33.     For i = 0 To objSset.Count - 1
    
34.         tstr = objSset.Item(i).TextString
    
35.         Debug.Print tstr
    
36.         reg.IgnoreCase = False
    
37.         reg.Global = True
    
38.         '替换\\字符
    
39.         reg.Pattern = "\\\"
    
40.         tstr = reg.Replace(tstr, Chr(1))
    
41.         '替换\{字符
    
42.         reg.Pattern = "\\{"
    
43.         tstr = reg.Replace(tstr, Chr(2))
    
44.         '替换\}字符
    
45.         reg.Pattern = "\\}"
    
46.         tstr = reg.Replace(tstr, Chr(3))
    
47.         '删除段落缩进格式
    
48.         reg.Pattern = "\\pi(.[^;]*);"
    
49.         tstr = reg.Replace(tstr, "")
    
50.         '删除制表符格式
    
51.         reg.Pattern = "\\pt(.[^;]*);"
    
52.         tstr = reg.Replace(tstr, "")
    
53.         '删除堆迭格式
    
54.         reg.Pattern = "\\S(.[^;]*)(\^|#|\\)(.[^;]*);"
    
55.         tstr = reg.Replace(tstr, "")
    
56.         '删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
    
57.         reg.Pattern = "(\\F|\\f|\\C|\\H|\\T|\\Q|\\W|\\A)(.[^;]*);"
    
58.         tstr = reg.Replace(tstr, "")
    
59.         '删除下划线、删除线格式
    
60.         reg.Pattern = "(\\L|\\O|\\l|\\o)"
    
61.         tstr = reg.Replace(tstr, "")
    
62.         '删除不间断空格格式
    
63.         reg.Pattern = "\\~"
    
64.         tstr = reg.Replace(tstr, "")
    
65.         '删除换行符格式
    
66.         '.Pattern = "\\P"
    
67.         '.Replace tstr, "\r\n"
    
68.         '删除{}
    
69.         reg.Pattern = "({|})"
    
70.         tstr = reg.Replace(tstr, "")
    
71.         '替换回\\,\{,\}字符
    
72.         reg.Pattern = "\x01"
    
73.         tstr = reg.Replace(tstr, "")
    
74.         reg.Pattern = "\x01"
    
75.         tstr = reg.Replace(tstr, "{")
    
76.         reg.Pattern = "\x01"
    
77.         tstr = reg.Replace(tstr, "}")
    
78.     Next i
    
79.     Debug.Print tstr
    
80. End Sub
    

Private Sub SelectAllText(ByVal App As Object, objSset As Object, Optional ByVal strSsetname As String = "SELECTION~TEXT~1111")<br />     On Error GoTo err1<br />     Dim flag As Boolean<br />     flag = False<br />     For Each objSset In App.SelectionSets<br />         If objSset.Name = strSsetname Then<br />             flag = True<br />             Exit For<br />         End If<br />     Next<br />     If flag Then objSset.Delete      '创建集合，如集存在，则删除，再新建<br />     Set objSset = App.SelectionSets.Add(strSsetname)<br />     Dim gpCode(0) As Integer<br />     Dim dataValue(0) As Variant<br />     gpCode(0) = 0<br />     dataValue(0) = "text,mtext"<br />     Dim groupCode As Variant, dataCode As Variant<br />     groupCode = gpCode<br />     dataCode = dataValue<br />     objSset.SelectOnScreen groupCode, dataCode<br />     Exit Sub<br /> err1:<br />     Debug.Print Err.Description<br />     Err.Clear<br /> End Sub<br /> <br /> Sub TT()<br />     Dim tstr As String, objSset As Object, objtrans As Object, reg As RegExp, objEntArr As New Collection, i As Integer, j As Integer<br />     Set Acdoc = AcadApplication.ActiveDocument<br />     SelectAllText Acdoc, objSset<br />     Set reg = CreateObject("Vbscript.RegExp")<br />     For i = 0 To objSset.Count - 1<br />         tstr = objSset.Item(i).TextString<br />         Debug.Print tstr<br />         reg.IgnoreCase = False<br />         reg.Global = True<br />         '替换\\字符<br />         reg.Pattern = "\\\"<br />         tstr = reg.Replace(tstr, Chr(1))<br />         '替换\{字符<br />         reg.Pattern = "\\{"<br />         tstr = reg.Replace(tstr, Chr(2))<br />         '替换\}字符<br />         reg.Pattern = "\\}"<br />         tstr = reg.Replace(tstr, Chr(3))<br />         '删除段落缩进格式<br />         reg.Pattern = "\\pi(.[^;]*);"<br />         tstr = reg.Replace(tstr, "")<br />         '删除制表符格式<br />         reg.Pattern = "\\pt(.[^;]*);"<br />         tstr = reg.Replace(tstr, "")<br />         '删除堆迭格式<br />         reg.Pattern = "\\S(.[^;]*)(\^|#|\\)(.[^;]*);"<br />         tstr = reg.Replace(tstr, "")<br />         '删除字体、颜色、字高、字距、倾斜、字宽、对齐格式<br />         reg.Pattern = "(\\F|\\f|\\C|\\H|\\T|\\Q|\\W|\\A)(.[^;]*);"<br />         tstr = reg.Replace(tstr, "")<br />         '删除下划线、删除线格式<br />         reg.Pattern = "(\\L|\\O|\\l|\\o)"<br />         tstr = reg.Replace(tstr, "")<br />         '删除不间断空格格式<br />         reg.Pattern = "\\~"<br />         tstr = reg.Replace(tstr, "")<br />         '删除换行符格式<br />         '.Pattern = "\\P"<br />         '.Replace tstr, "\r\n"<br />         '删除{}<br />         reg.Pattern = "({|})"<br />         tstr = reg.Replace(tstr, "")<br />         '替换回\\,\{,\}字符<br />         reg.Pattern = "\x01"<br />         tstr = reg.Replace(tstr, "")<br />         reg.Pattern = "\x01"<br />         tstr = reg.Replace(tstr, "{")<br />         reg.Pattern = "\x01"<br />         tstr = reg.Replace(tstr, "}")<br />     Next i<br />     Debug.Print tstr<br /> End Sub<br />

fangmin723

mikewolf2k 发表于 2018-12-14 09:11
清理格式符号那段的确很像以前网上发布的代码，值得一提的是，那段代码有一处错误，我修正了。

我在论坛搜了，用了还是出现错误

mikewolf2k

fangmin723 发表于 2018-12-14 08:10
难道版主以前写过？？？

清理格式符号那段的确很像以前网上发布的代码，值得一提的是，那段代码有一处错误，我修正了。

fangmin723

zzyong00 发表于 2018-12-13 17:40
看着太熟悉了。。。

论坛里面确实有一个，但是有错误，我就把我之前收集的发上来了！

zzyong00

看着太熟悉了。。。

fangmin723

zzyong00 发表于 2018-12-13 17:40
看着太熟悉了。。。

难道版主以前写过？？？

bnjzzheng

多谢楼主分享源码

MTC

这个源码应该是一本书上的，前几天看到过

664571221

群主你们说的错误修改好了吗

664571221

这个怎么编程dvb程序