Select Sub-Assembly by custom Properties

Hi,

I need to select Sub assembly (Not Top level) by its Custom Property.

I have Codes to select component by Custom property, Is there any way to select sub Assembly?

Option Explicit

    Dim swApp                      As Object

    Dim swModel                    As Object

    Dim swConf                      As Object

    Dim swRootComp                  As Object

Sub main()

    Dim swApp As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2

    Dim str As String

    ' Constant enumerators

    Const swDocPART = 1

    Const swDocASSEMBLY = 2

    Const swDocDRAWING = 3

    Set swApp = CreateObject("SldWorks.Application")

    Set swModel = swApp.ActiveDoc

    If swModel Is Nothing Then

        ' If no model currently loaded, then exit

        End

    End If

    ' Determine the document type

    ' If the document is not a drawing, then send a message to the user

    If (swModel.GetType <> swDocASSEMBLY) Then

        MsgBox "This Feature only for ASSEMBLY !", vbCritical, "Avantek Tools"

        End

     Else

     Call TRAVCOMP

     Debug.Print "ok"

    End If

   

End Sub

Sub TraverseComponent(swComp As Object, nLevel As Long)

    Dim vChildComp                  As Variant

    Dim swChildComp                As Object

    Dim swCompConfig                As Object

    Dim sPadStr                    As String

    Dim i                          As Long

    Dim retval, retval1                      As String

    Dim bRet                        As Boolean

   

For i = 0 To nLevel - 1

        sPadStr = sPadStr + "  "

    Next i

    vChildComp = swComp.GetChildren

    For i = 0 To UBound(vChildComp)

        Set swChildComp = vChildComp(i)

        TraverseComponent swChildComp, nLevel + 1

       

        Set swModel = swChildComp.GetModelDoc

        

        If Not swModel Is Nothing Then

            retval1 = swModel.CustomInfo2("", "Description")

              If InStr((retval1), "StripLayout") > 0 Then

                bRet = swChildComp.Select(True) 'SELECTS COMPONENT

            End If

        End If

    Next i

End Sub

Sub TRAVCOMP()

    Set swApp = CreateObject("SldWorks.Application")

    Set swModel = swApp.ActiveDoc

    Set swConf = swModel.GetActiveConfiguration

    Set swRootComp = swConf.GetRootComponent

    Debug.Print "File = " & swModel.GetPathName

    Dim swModel2 As SldWorks.ModelDoc2

    Set swApp = Application.SldWorks

    Set swModel2 = swApp.ActiveDoc

    swModel2.ClearSelection2 True

    TraverseComponent swRootComp, 1

    Dim obj As Object

       

    swModel.Extension.RunCommand swCommands_HideShowComponents, Empty

  

swModel2.ClearSelection2 True

End Sub

Thanks

SolidworksApi macros