For those of you that pre-configure assemblies and drawings, you may have encountered this problem. Let's say you have a template assembly with 10 parts and a master drawing template for that assembly. If, for a particular job, you need to remove (or supress) 3 items from the assembly, you will notice that some dimensions, annotations and weld symbols may be left dangling on your master drawing template. These can take some time to delete if the drawing is quite large or if it's based on a large master assembly.

Here is some code you can insert into a macro file and link to a macro button. This will automatically remove all of the dangling items. The only problem is that it will not work on section views. This lies in the fact that the View.Name property returns the name shown in the Feature Manager Design Tree, while the value of the items use the name format "Drawing ViewX".

CODE

'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'  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

Back to SolidWorks 3D CAD products FAQ Index
Back to SolidWorks 3D CAD products Forum
My FAQ Archive

Email This FAQ To A Friend

My Archive

My FAQ Archive