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:
SolidworksApi/macrosOption 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
Else
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
Wend
End If
Next
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
Next
End If
End If
Next
End If
End Sub