'<><><><><><><><><><><><><><><><><><>
' List Top Level Parts in an Assembly
'<><><><><><><><><><><><><><><><><><>
Option Explicit
Const swDocASSEMBLY = 2
Sub Main()
Dim swApp As Object
Dim swAssy As Object
Dim swConfig As Object
Dim swRoot As Object
Dim swComp() As Object
Dim swChild As Object
Dim sAssyName As String
Dim i As Integer
Dim ChildCount As Integer
Dim sMsg As String
Set swApp = CreateObject("SldWorks.Application")
Set swAssy = swApp.ActiveDoc
If (swAssy.GetType <> swDocASSEMBLY) Then
swApp.SendMsgToUser "You need to open an Assembly"
Exit Sub
End If
'Get Assy Name - Strip Extension
sAssyName = swAssy.GetTitle
If InStr(1, sAssyName, ".") Then
sAssyName = Left$(sAssyName, InStr(1, sAssyName, ".") - 1)
End If
'Find the Root Component
Set swConfig = swAssy.GetActiveConfiguration()
Set swRoot = swConfig.GetRootComponent()
swComp = swRoot.GetChildren
'Find Children
ChildCount = UBound(swComp) + 1
sMsg = ChildCount & " Items"
For i = 0 To (ChildCount - 1)
Set swChild = swComp(i)
sMsg = sMsg & vbCrLf & swChild.Name
Next i
'Report Results
swApp.SendMsgToUser sMsg
'Clean Up
Set swChild = Nothing
Set swRoot = Nothing
Set swConfig = Nothing
Set swAssy = Nothing
Set swApp = Nothing
End Sub