Get Parent-Child Relationship for Component Example (VBA)
This example shows how to get the parent-child relationship for an assembly
component.
'------------------------------------------------
'
' Preconditions:
' (1)
Assembly is open.
' (2)
Component is selected in the FeatureManager design tree or
' something
is selected in the graphics area.
' (3)
Selected item is not in a sub-assembly.
'
' Postconditions: None
'
' NOTE: This example does not currently support selection
in subassemblies
' because
the selected (sub)component is not a feature
' in
the top-level assembly.
'
'-------------------------------------------------
Option Explicit
Sub ProcessFeature _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swFeat
As SldWorks.feature _
)
Dim
vParentArr As
Variant
Dim
vParent As
Variant
Dim
swParentFeat As
SldWorks.feature
Dim
vChildArr As
Variant
Dim
vChild As
Variant
Dim
swChildFeat As
SldWorks.feature
Dim
i As
Long
vParentArr
= swFeat.GetParents
vChildArr
= swFeat.GetChildren
Debug.Print
" FeatName
= " + swFeat.Name + "
[" + swFeat.GetTypeName +
"]"
If
Not IsEmpty(vParentArr) Then
Debug.Print
" Parents:"
For
Each vParent In vParentArr
Set
swParentFeat = vParent
Debug.Print
" "
+ swParentFeat.Name + " ["
+ swParentFeat.GetTypeName + "]"
Next
vParent
End
If
If
Not IsEmpty(vChildArr) Then
Debug.Print
" Children:"
For
Each vChild In vChildArr
Set
swChildFeat = vChild
Debug.Print
" "
+ swChildFeat.Name + " ["
+ swChildFeat.GetTypeName + "]"
Next
vChild
End
If
End Sub
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swAssy As
SldWorks.AssemblyDoc
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swComp As
SldWorks.Component2
Dim
swFeat As
SldWorks.feature
Dim
i As
Long
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swAssy = swModel
Set
swSelMgr = swModel.SelectionManager
Set
swComp = swSelMgr.GetSelectedObjectsComponent(1)
Set
swFeat = swAssy.FeatureByName(swComp.Name2): Debug.Assert Not swFeat Is Nothing
Debug.Print
"File = " & swModel.GetPathName
ProcessFeature
swApp, swModel, swFeat
End Sub
'---------------------------------------