跳到主要内容

Macro to find and delete specific notes in the SOLIDWORKS drawing

This VBA macro allows to find and delete all notes in the SOLIDWORKS drawing based on the various criteria, such as by text, expression (property linked text), regular expression or empty values.

Configuration

Macro can be configured by modifying the constants

Const FILTER As String = "" 'filter to use whe SEARCH_TYPE is set to ByText or ByExpression
Const SEARCH_TYPE As Integer = SearchType_e.EmptyText 'Type of Search (ByText, ByExpression, EmptyText, EmptyExpression, All)
Const USE_REGULAR_EXPRESSION As Boolean = False 'True to treat value in the FILTER constant as regular expressions

Finding All Notes

Set the value of SEARCH_TYPE constant to All and all notes will be found and deleted

Searching By Text

Set the value of the display text of the note to the FILTER constant and SEARCH_TYPE to ByText and all notes which match this value will be found and deleted.

Searching By Expression

Set the value of the expression (property linked text) of the note to the FILTER constant and SEARCH_TYPE to ByExpression and all notes which match this value will be found and deleted.

This can be used to find the notes linked to custom properties, for example the below example will find all notes which are linked to the Part Number custom property of the drawing.

Const FILTER As String = "$PRPSHEET:""Part Number"""
Const SEARCH_TYPE As Integer = SearchType_e.ByExpression
Const USE_REGULAR_EXPRESSION As Boolean = False

Searching By Empty Text Or Expression

Set the value of SEARCH_TYPE constant to EmptyText or EmptyExpression and all empty notes will be found and deleted

Regular Expressions

For more advanced searching options it is possible to use the regular expressions. To enable this option set the USE_REGULAR_EXPRESSION to True. See Regular Expressions for more information

Example below will find and delete all notes which contain numeric value.

Const FILTER As String = "\d+"
Const SEARCH_TYPE As Integer = SearchType_e.ByText
Const USE_REGULAR_EXPRESSION As Boolean = True
Enum SearchType_e
ByText
ByExpression
EmptyText
EmptyExpression
All
End Enum

Const FILTER As String = ""
Const SEARCH_TYPE As Integer = SearchType_e.EmptyText
Const USE_REGULAR_EXPRESSION As Boolean = False

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

DeleteNotes swDraw

Else
Err.Raise vbError, "", "Only drawings are supported"
End If

End Sub

Sub DeleteNotes(draw As SldWorks.DrawingDoc)

Dim currentSheetName As String
currentSheetName = draw.GetCurrentSheet().GetName

Dim vSheets As Variant
vSheets = draw.GetViews

Dim i As Integer

For i = 0 To UBound(vSheets)

Dim vViews As Variant
vViews = vSheets(i)

draw.ActivateSheet vViews(0).Name
draw.ClearSelection2 False

Dim j As Integer

For j = 0 To UBound(vViews)

Dim swView As SldWorks.View
Set swView = vViews(j)

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)

If ShouldDeleteNote(swNote) Then

Dim swAnn As SldWorks.Annotation
Set swAnn = swNote.GetAnnotation

Debug.Print "Deleting " & swNote.GetText & " (" & swNote.PropertyLinkedText & ")"

swAnn.Select3 True, Nothing

End If

Next

Next

If draw.SelectionManager.GetSelectedObjectCount2(-1) > 0 Then
If False <> draw.Extension.DeleteSelection2(swDeleteSelectionOptions_e.swDelete_Absorbed) Then
draw.SetSaveFlag
Else
Err.Raise vbError, "", "Failed to delete annotations"
End If
End If

Next

draw.ActivateSheet currentSheetName

End Sub

Function ShouldDeleteNote(note As SldWorks.note) As Boolean

Dim value As String

Select Case SEARCH_TYPE
Case SearchType_e.All
ShouldDeleteNote = True
Exit Function
Case SearchType_e.EmptyText
ShouldDeleteNote = note.GetText() = ""
Exit Function
Case SearchType_e.EmptyExpression
ShouldDeleteNote = note.PropertyLinkedText = ""
Exit Function
Case SearchType_e.ByText
value = note.GetText()
Case SearchType_e.ByExpression
value = note.PropertyLinkedText
End Select

If USE_REGULAR_EXPRESSION Then
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")

regEx.Global = True
regEx.IgnoreCase = True
regEx.Pattern = FILTER

ShouldDeleteNote = regEx.Test(value)
Else
ShouldDeleteNote = (value = FILTER)
End If

End Function