从SOLIDWORKS图纸中将所有注释打印到文本文件的宏

这个VBA宏将从SOLIDWORKS图纸中的所有视图中输出文本到文本文件中。

每个注释将会在新的一行中打印。还可以将视图的名称和文件名包含在输出中。

配置

可以通过修改以下常量来配置宏

Const FILE_PATH As String = "" '注释应写入的文本文件的完整路径。如果为空，则将文件保存为与原始文件相同的名称，前缀为_Note.txt
Const PRINT_FILE_NAME As Boolean = True 'True表示将文件名输出到文本文件中
Const PRINT_VIEW_NAME As Boolean = True 'True表示将绘图视图名称输出到文本文件中
Const FILTER As String = "" '用于包含注释的正则表达式过滤器（例如，\d+表示包含所有包含数字值的注释）

注释

• 对于空注释，值将输出为[X]
• 有关可用于配置FILTER的正则表达式的更多信息，请参见正则表达式
• 注释将追加到现有的文本文件中（如果不存在，则创建新文件）。这允许通过Batch+批量运行此宏以从多个文件中输出注释。

Const FILE_PATH As String = ""
Const PRINT_FILE_NAME As Boolean = True
Const PRINT_VIEW_NAME As Boolean = True
Const FILTER As String = ""

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swDraw As SldWorks.DrawingDoc
    Set swDraw = swApp.ActiveDoc
    
    If Not swDraw Is Nothing Then
        
        Dim outFilePath As String
        
        If FILE_PATH <> "" Then
            outFilePath = FILE_PATH
        Else
            outFilePath = swDraw.GetPathName
            
            If outFilePath = "" Then
                Err.Raise "绘图未保存且未指定FILE_PATH"
            End If
            
            outFilePath = Left(outFilePath, InStrRev(outFilePath, ".") - 1) & "_Notes.txt"
        End If
        
        Dim fileNmb As Integer
        fileNmb = FreeFile
    
        Open outFilePath For Append As #fileNmb
    
        If PRINT_FILE_NAME Then
            Print #fileNmb, "*** 文件路径: " & swDraw.GetPathName & " ***"
        End If
    
        PrintNotes swDraw, fileNmb
        
        Print #fileNmb, ""
        Close #fileNmb
        
    Else
        Err.Raise vbError, "", "仅支持绘图"
    End If
    
End Sub

Sub PrintNotes(draw As SldWorks.DrawingDoc, fileNmb As Integer)
    
    Dim vSheets As Variant
    vSheets = draw.GetViews
    
    Dim i As Integer
        
    For i = 0 To UBound(vSheets)
        
        Dim vViews As Variant
        vViews = vSheets(i)
        
        Dim j As Integer
        
        For j = 0 To UBound(vViews)
            
            Dim swView As SldWorks.View
            Set swView = vViews(j)
            
            If PRINT_VIEW_NAME Then
                Print #fileNmb, "*** 视图名称: " & swView.Name & " ***"
            End If
            
            Dim vNotes As Variant
            vNotes = swView.GetNotes
            
            Dim k As Integer
            
            For k = 0 To UBound(vNotes)
                Dim swNote As SldWorks.Note
                Set swNote = vNotes(k)
                
                Dim text As String
                text = swNote.GetText
                
                If IncludeNote(text) Then
                    If text = "" Then
                        text = "[X]"
                    End If
                    
                    Print #fileNmb, text
                End If
                
            Next
            
        Next
        
    Next
    
End Sub

Function IncludeNote(text As String) As Boolean

    If FILTER = "" Then
        IncludeNote = True
    Else
        Dim regEx As Object
        Set regEx = CreateObject("VBScript.RegExp")
        
        regEx.Global = True
        regEx.IgnoreCase = True
        regEx.Pattern = FILTER
        
        IncludeNote = regEx.Test(text)
    
    End If
    
End Function