Get Display Dimensions, GTols, and Surface-Finish Symbols Example (VBA)

This example shows how to get all of the displayed dimensions, GTols, and surface-finish symbols.

 

'-----------------------------------------------

'

' Preconditions: Part, assembly, or drawing document is open.

'

' Postconditions: None

'

'-----------------------------------------------

Option Explicit

Sub ProcessAnnotation _

( _

    swApp As SldWorks.SldWorks, _

    swAnn As SldWorks.Annotation _

)

    Dim swAnnCThread                As SldWorks.CThread

    Dim swAnnDatumTag               As SldWorks.DatumTag

    Dim swAnnDatumTargetSym         As SldWorks.DatumTargetSym

    Dim swAnnDisplayDimension       As SldWorks.DisplayDimension

    Dim swAnnGTol                   As SldWorks.Gtol

    Dim swAnnNote                   As SldWorks.note

    Dim swAnnSFSymbol               As SldWorks.SFSymbol

    Dim swAnnWeldSymbol             As SldWorks.WeldSymbol

    Dim swAnnCustomSymbol           As SldWorks.CustomSymbol

    Dim swAnnDowelSym               As SldWorks.DowelSymbol

    Dim swAnnLeader                 As SldWorks.MultiJogLeader

    Dim swAnnCenterMarkSym          As SldWorks.CenterMark

    Dim swAnnTable                  As SldWorks.TableAnnotation

    Dim swAnnCenterLine             As SldWorks.CenterLine

    Dim swAnnDatumOrigin            As SldWorks.DatumOrigin

    

    Select Case swAnn.GetType

        Case swCThread

            Set swAnnCThread = swAnn.GetSpecificAnnotation

            Debug.Print "  swCThread"

            

        Case swDatumTag

            Set swAnnDatumTag = swAnn.GetSpecificAnnotation

            Debug.Print "  swDatumTag"

        

        Case swDatumTargetSym

            Set swAnnDatumTargetSym = swAnn.GetSpecificAnnotation

            Debug.Print "  swDatumTargetSym"

            

        Case swDisplayDimension

            Set swAnnDisplayDimension = swAnn.GetSpecificAnnotation

            Debug.Print "  swDisplayDimension"

            

        Case swGTol

            Set swAnnGTol = swAnn.GetSpecificAnnotation

            Debug.Print "  swGTol"

            

        Case swNote

            Set swAnnNote = swAnn.GetSpecificAnnotation

            Debug.Print "  swNote"

            

        Case swSFSymbol

            Set swAnnSFSymbol = swAnn.GetSpecificAnnotation

            Debug.Print "  swSFSymbol"

            

        Case swWeldSymbol

            Set swAnnWeldSymbol = swAnn.GetSpecificAnnotation

            Debug.Print "  swWeldSymbol"

            

        Case swCustomSymbol

            Set swAnnCustomSymbol = swAnn.GetSpecificAnnotation

            Debug.Print "  swCustomSymbol"

            

        Case swDowelSym

            Set swAnnDowelSym = swAnn.GetSpecificAnnotation

            Debug.Print "  swDowelSym"

            

        Case swLeader

            Set swAnnLeader = swAnn.GetSpecificAnnotation

            Debug.Print "  swLeader"

                  

        Case swCenterMarkSym

            Set swAnnCenterMarkSym = swAnn.GetSpecificAnnotation

            Debug.Print "  swCenterMarkSym"

            

        Case swTableAnnotation

            Set swAnnTable = swAnn.GetSpecificAnnotation

            Debug.Print "  swTableAnnotation"

            

        Case swCenterLine

            Set swAnnCenterLine = swAnn.GetSpecificAnnotation

            Debug.Print "  swCenterLine"

            

        Case swDatumOrigin

            Set swAnnDatumOrigin = swAnn.GetSpecificAnnotation

            Debug.Print "  swDatumOrigin"

            

        Case Else

            Debug.Print "    Unknown annotation type"

            Debug.Assert False

    End Select

End Sub

Sub ProcessModel _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    nLevel As Long _

)

    Dim swAnn                       As SldWorks.Annotation

    Dim nNumLeader                  As Long

    Dim nNumPts                     As Long

    Dim vLeaderPt                   As Variant

    

    Dim sPadSpace                   As String

    Dim i                           As Long

    Dim j                           As Long

    Dim bRet                        As Boolean

    

    

    For i = 0 To nLevel

        sPadSpace = sPadSpace & "  "

    Next i

    

    Debug.Print sPadSpace & swModel.GetPathName

    

    Set swAnn = swModel.GetFirstAnnotation2

    

    Do While Not swAnn Is Nothing

        Debug.Print sPadSpace & "  " & swAnn.GetName & " [" & swAnn.GetType & "]"

        

        If True = swAnn.GetLeader Then

            For i = 0 To swAnn.GetLeaderCount - 1

                If True = swAnn.GetBentLeader Then

                    nNumPts = 3

                Else

                    nNumPts = 2

                End If

                

                vLeaderPt = swAnn.GetLeaderPointsAtIndex(i)

                For j = 0 To nNumPts - 1

                    Debug.Print sPadSpace & "    Pt[" & Str(i) & "] = (" & _

                            Str(vLeaderPt(3 * j & 0)) & "," & _

                            Str(vLeaderPt(3 * j & 1)) & "," & _

                            Str(vLeaderPt(3 * j & 2)) & ")"

                Next j

            Next i

        End If

        Debug.Print ""

        ProcessAnnotation swApp, swAnn

        

        Set swAnn = swAnn.GetNext3

    Loop

End Sub

Sub ProcessComponent _

( _

    swApp As SldWorks.SldWorks, _

    swComp As SldWorks.Component2, _

    nLevel As Long _

)

    Dim vChildArray             As Variant

    Dim swChildComp             As SldWorks.Component2

    Dim swModel                 As SldWorks.ModelDoc2

    Dim swPart                  As SldWorks.PartDoc

    Dim i                       As Long

    

    nLevel = nLevel & 1

    vChildArray = swComp.GetChildren

    

    For i = 0 To UBound(vChildArray)

        Set swChildComp = vChildArray(i)

        ProcessComponent swChildComp, nLevel

    Next i

    

    Set swModel = swComp.GetModelDoc

    

    If Not swModel Is Nothing Then

        If swDocPART = swModel.GetType Then

            ProcessModel swModel, nLevel

        End If

    End If

End Sub

Sub ProcessDrawing _

( _

    swApp As SldWorks.SldWorks, _

    swDraw As SldWorks.DrawingDoc _

)

    Dim swView                      As SldWorks.View

    Dim swAnn                       As SldWorks.Annotation

    

    Set swView = swDraw.GetFirstView

    Do While Not Nothing Is swView

        Set swAnn = swView.GetFirstAnnotation3

        Do While Not Nothing Is swAnn

            ProcessAnnotation swApp, swAnn

            

            Set swAnn = swAnn.GetNext3

        Loop

        Set swView = swView.GetNextView

    Loop

End Sub

Sub main()

    Dim swApp                       As SldWorks.SldWorks

    Dim swModel                     As SldWorks.ModelDoc2

    Dim swAssy                      As SldWorks.AssemblyDoc

    Dim swDraw                      As SldWorks.DrawingDoc

    Dim swConfig                    As SldWorks.configuration

    Dim swConfigMgr                 As SldWorks.ConfigurationMgr

    Dim swRootComp                  As SldWorks.Component2

    Dim nStatus                     As Long

    Dim bRet                        As Boolean

    

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    

    Select Case swModel.GetType

        Case swDocPART

            ProcessModel swApp, swModel, 0

            

        Case swDocASSEMBLY

            Set swAssy = swModel

            nStatus = swAssy.ResolveAllLightWeightComponents(False)

            Set swConfigMgr = swModel.ConfigurationManager

            Set swConfig = swConfigMgr.ActiveConfiguration

            Set swRootComp = swConfig.GetRootComponent

            

            ProcessComponent swApp, swRootComp, 0

            

        Case swDocDRAWING

            Set swDraw = swModel

            

            ProcessDrawing swApp, swDraw

        

        Case Else

            Exit Sub

    End Select

End Sub

'-----------------------------------------------