fangmin723 发表于 2018-12-13 15:11:00

清除CAD多行文字所有格式-(VBA)


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

fangmin723 发表于 2018-12-14 09:15:00


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

mikewolf2k 发表于 2018-12-14 09:11:00


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

fangmin723 发表于 2018-12-14 09:18:00


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

zzyong00 发表于 2018-12-13 17:40:00

看着太熟悉了。。。

fangmin723 发表于 2018-12-14 08:10:00


难道版主以前写过???

bnjzzheng 发表于 2020-8-4 18:36:00

多谢楼主分享源码

MTC 发表于 2021-6-4 16:48:00

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

664571221 发表于 2021-11-13 15:45:00

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

664571221 发表于 2021-11-14 15:43:00

这个怎么编程dvb程序
页: [1]
查看完整版本: 清除CAD多行文字所有格式-(VBA)