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