Remove Dangling Drawing Entities

'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'  Utility - Remove Dangling Dimensions, Annotations and Weld Symbols
'
'  Written by:  Dimensional Solutions, Inc.
'               DimensionalSoutions@core.com
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
Option Explicit

Const swSelNOTHING = 0

Sub main()
    Dim swApp As Object
    Dim Part As Object
    Dim dwgView As Object
    Dim dispDimension As Object
    Dim dwgDimension As Object
    Dim dwgNote As Object
    Dim dwgWeld As Object
    Dim dwgAnnotation As Object
    Dim attachedEntitiesArray As Variant
    Dim attachedEntityTypes As Variant
    Dim bRemoveLastFlag As Boolean
    Dim s1 As String
    Dim sViewName As String, sDwgName As String
    
    Set swApp = CreateObject("SldWorks.Application")
    Set Part = swApp.ActiveDoc
 
    Set dwgView = Part.GetFirstView     'this is the drawing template
    
    Do While Not dwgView Is Nothing
        'Travserse Through the Dimensions
        Set dwgView = dwgView.GetNextView
        If Not dwgView Is Nothing Then
            sViewName = dwgView.Name
            'Travserse through all of the dimensions in this view
            Set dispDimension = dwgView.GetFirstDisplayDimension3
            Do While Not dispDimension Is Nothing
                Set dwgDimension = dispDimension.GetDimension
                bRemoveLastFlag = False
                If dwgDimension.Value = 0 Then
                    'Delete the Dimension
                    If InStr(1, dwgDimension.FullName, "Annotations") Then
                        'The next dimension must be selected before this one can be removed
                        bRemoveLastFlag = True
                        s1 = dwgDimension.Name & "@" & sViewName
                    End If
                End If
                Set dispDimension = dispDimension.GetNext3
                If bRemoveLastFlag = True Then
                    Part.SelectByID s1, "DIMENSION", 0, 0, 0
                    Part.DeleteSelection False
                    bRemoveLastFlag = False
                End If
            Loop
            'Travserse through all of the reference dimensions in this view
            Set dispDimension = dwgView.GetFirstDisplayDimension3
            Do While Not dispDimension Is Nothing
                Set dwgAnnotation = dispDimension.GetAnnotation
                'Only allow this to act on Reference Dimensions
                If dwgAnnotation.GetName Like "RD*" Then
                    attachedEntitiesArray = dwgAnnotation.GetAttachedEntities
                    attachedEntityTypes = dwgAnnotation.GetAttachedEntityTypes
                    If IsEmpty(attachedEntitiesArray) _
                     Or IsNull(attachedEntitiesArray) Then
                        'Delete the Ref Dim -  next one must be selected before this on can be removed
                        bRemoveLastFlag = True
                        s1 = dwgAnnotation.GetName & "@" & dwgView.Name
                    ElseIf attachedEntityTypes(0) = swSelNOTHING _
                     Or attachedEntitiesArray(0) Is Nothing Then        'Dangling
                        'Delete the Ref Dim -  next one must be selected before this on can be removed
                        bRemoveLastFlag = True
                        s1 = dwgAnnotation.GetName & "@" & dwgView.Name
                    ElseIf (UBound(attachedEntitiesArray) + 1) >= 2 Then '(# of attached items)
                        If attachedEntityTypes(1) = swSelNOTHING _
                        Or attachedEntitiesArray(1) Is Nothing Then        'Dangling
                            'Delete the Ref Dim -  next one must be selected before this on can be removed
                            bRemoveLastFlag = True
                            s1 = dwgAnnotation.GetName & "@" & dwgView.Name
                        End If
                    Else
                        'Attached
                    End If
                End If
                Set dispDimension = dispDimension.GetNext3
                If bRemoveLastFlag = True Then
                    Part.SelectByID s1, "DIMENSION", 0, 0, 0
                    Part.DeleteSelection False
                    bRemoveLastFlag = False
                End If
            Loop
            'Traverse through all of the notes in this drawing view
            Set dwgNote = dwgView.GetFirstNote
            Do While Not dwgNote Is Nothing
                Set dwgAnnotation = dwgNote.GetAnnotation
                bRemoveLastFlag = False
                attachedEntitiesArray = dwgAnnotation.GetAttachedEntities
                attachedEntityTypes = dwgAnnotation.GetAttachedEntityTypes
                If IsEmpty(attachedEntitiesArray) _
                 Or IsNull(attachedEntitiesArray) Then
                    'Not Attached (And Never Was)
                ElseIf attachedEntityTypes(0) = swSelNOTHING _
                 Or attachedEntitiesArray(0) Is Nothing Then        'Dangling
                    'Delete the Note
                    'The next note must be selected before this on can be removed
                    bRemoveLastFlag = True
                    s1 = dwgNote.GetName & "@" & sViewName
                Else
                    'Attached
                End If
                Set dwgNote = dwgNote.GetNext
                If bRemoveLastFlag = True Then
                    Part.SelectByID s1, "NOTE", 0, 0, 0
                    Part.DeleteSelection False
                    bRemoveLastFlag = False
                End If
            Loop
            'Traverse through all of the welds in this drawing view
            Set dwgWeld = dwgView.GetFirstWeldSymbol
            Do While Not dwgWeld Is Nothing
                Set dwgAnnotation = dwgWeld.GetAnnotation
                bRemoveLastFlag = False
                attachedEntitiesArray = dwgAnnotation.GetAttachedEntities
                attachedEntityTypes = dwgAnnotation.GetAttachedEntityTypes
                If IsEmpty(attachedEntitiesArray) _
                 Or IsNull(attachedEntitiesArray) Then
                    'Not Attached (And Never Was)
                ElseIf attachedEntityTypes(0) = swSelNOTHING _
                 Or attachedEntitiesArray(0) Is Nothing Then        'Dangling
                    'Delete the Note
                    'The next note must be selected before this one can be removed
                    bRemoveLastFlag = True
                    s1 = dwgAnnotation.GetName & "@" & sViewName
                Else
                    'Attached
                End If
                Set dwgWeld = dwgWeld.GetNext
                If bRemoveLastFlag = True Then
                    Part.SelectByID s1, "WELD", 0, 0, 0
                    Part.DeleteSelection False
                    bRemoveLastFlag = False
                End If
            Loop
        End If
    Loop
    Set swApp = Nothing
    Set Part = Nothing
    Set dwgView = Nothing
    Set dispDimension = Nothing
    Set dwgDimension = Nothing
    Set dwgNote = Nothing
    Set dwgWeld = Nothing
    Set dwgAnnotation = Nothing
    MsgBox "Done!"
End Sub