AnsweredAssumed Answered

How to select a sketch circle in all parts of an assembly

Question asked by Fifi Riri on Mar 19, 2019
Latest reply on Mar 19, 2019 by Fifi Riri

Hi everyone,

I'm trying to select a circle "Arc1" in sketch "Sketch1" in all parts of an assembly and sub-assemblies for mate purpose.

I can find them by traversing the components and features, but I can't select them with Select4.

I try to use GetCorresponding from:

2018 SOLIDWORKS API Help - Get Corresponding Objects in Assembly Component Example (VBA)

but I can't figure it out.


Here is my code so far:


Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swAssyModel As SldWorks.ModelDoc2
Sub main()
    Set swApp = Application.SldWorks
    Set swAssyModel = swApp.ActiveDoc
    If swAssyModel.GetType <> swDocumentTypes_e.swDocASSEMBLY Then
        Exit Sub
    End If
    Dim swConf As SldWorks.Configuration
    Set swConf = swAssyModel.GetActiveConfiguration
    TraverseComponent swConf.GetRootComponent3(True)
End Sub

Sub TraverseComponent(ByVal swcomp As SldWorks.Component2)
    Dim vChild As Variant
    Dim swChildComp As SldWorks.Component2
    Dim swComponent As SldWorks.Component2
    Dim swmodel As SldWorks.ModelDoc2
    Dim swAssy As SldWorks.AssemblyDoc
    Dim swFeat As SldWorks.Feature
    Set swAssy = swAssyModel
    For Each vChild In swcomp.GetChildren
        Set swChildComp = vChild
        Set swmodel = swChildComp.GetModelDoc2
        If swmodel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
            'search in sub-assemblies
            TraverseComponent swChildComp
        Set swFeat = swmodel.FirstFeature
        While Not swFeat Is Nothing
            'Debug.Print swFeat.GetTypeName
            If swFeat.GetTypeName = "Extrusion" Then
               ProcessFeature swmodel, swChildComp, swFeat
            End If
            Set swFeat = swFeat.GetNextFeature
        End If
End Sub

Sub ProcessFeature(ByVal swmodel As SldWorks.ModelDoc2, ByVal swcomp As SldWorks.Component2, ByVal swFeat As SldWorks.Feature)
    Dim vParentArr As Variant
    Dim vParent As Variant
    Dim swParentFeat As SldWorks.Feature
    Dim boolstatus As Boolean
    vParentArr = swFeat.GetParents
    If Not IsEmpty(vParentArr) Then
        For Each vParent In vParentArr
            Set swParentFeat = vParent
            'debug.print swParentFeat.Name
            If swParentFeat.Name = "Sketch1" Then
                Debug.Print "      " + swParentFeat.Name + " " + swParentFeat.GetTypeName
                Dim swSketch As SldWorks.Sketch
                Set swSketch = swParentFeat.GetSpecificFeature
                Dim vSketchSegments As Variant
                Dim vSketchSegment As Variant
                Dim swSketchSegment As SldWorks.SketchSegment
                vSketchSegments = swSketch.GetSketchSegments
                If (Not IsEmpty(vSketchSegments)) Then
                    For Each vSketchSegment In vSketchSegments
                        Set swSketchSegment = vSketchSegment
                        If swSketchSegment.GetName = "Arc1" Then
                           boolstatus = swSketchSegment.Select4(True, Nothing) ' <= Doesn't work
                        End If
                End If
            End If
    End If
End Sub