Sub ll()

  Dim swApp As SldWorks.SldWorks, swModel As ModelDoc2, swAssy As AssemblyDoc

  Set swApp = Application.SldWorks

  Set swModel = swApp.ActiveDoc

  Set swAssy = swModel

  ''

  Dim swComp As Component2, vComp As Component2, vModel As ModelDoc2

  Dim swFeat As Feature, vFeat As Feature

  Dim SwSelMgr As SelectionMgr, Str

  Set SwSelMgr = swModel.SelectionManager

  Set swFeat = swModel.FirstFeature

  Do While Not swFeat Is Nothing

     If swFeat.GetTypeName = "Reference" Then

         swFeat.Select False ' → can be select feature in Feature tree

         Set swComp = SwSelMgr.GetSelectedObjectsComponent(1)

         Str = swComp.GetModelDoc.GetTitle

         If UCase(Str) Like "*SLDASM*" Then

           Set vModel = swComp.GetModelDoc

           Set vFeat = vModel.FirstFeature

           vFeat.GetFirstSubFeature

           Do While Not vFeat Is Nothing

              If vFeat.GetTypeName = "Reference" Then

                 Debug.Print vModel.GetTitle, vFeat.Name, vFeat.GetTypeName

                 vFeat.Select False → don't select feature in Feature tree

              End If

              Set vFeat = vFeat.GetNextFeature

           Loop

         End If

     End If

     Set swFeat = swFeat.GetNextFeature

  Loop

End Sub

**********************

Question

swFeat.Select False→can be select feature in Feature tree

*************************

vFeat.Select False→ don't select Feature in Feature Tree

Help me , How to select feature in picture.

Thanks

*********************

Sub ll()

  Dim swApp As SldWorks.SldWorks, swModel As ModelDoc2, swAssy As AssemblyDoc

  Set swApp = Application.SldWorks

  Set swModel = swApp.ActiveDoc

  Set swAssy = swModel

  ''

  Dim swComp As Component2, vComp As Component2, vModel As ModelDoc2

  Dim swFeat As Feature, vFeat As Feature

  Dim SwSelMgr As SelectionMgr, Str, AsmFile

  Set SwSelMgr = swModel.SelectionManager

  Set swFeat = swModel.FirstFeature

  Do While Not swFeat Is Nothing

     If swFeat.GetTypeName = "Reference" Then

         swFeat.Select False

         Set swComp = SwSelMgr.GetSelectedObjectsComponent(1)

         Str = swComp.GetModelDoc.GetTitle

         If UCase(Str) Like "*SLDASM*" Then

          AsmFile = swComp.GetPathName

           Set vModel = swApp.ActivateDoc2(AsmFile, False, 0)  'swComp.GetModelDoc

           Debug.Print

           Debug.Print

           Set vFeat = vModel.FirstFeature

           vFeat.GetFirstSubFeature

           Do While Not vFeat Is Nothing

              If vFeat.GetTypeName = "Reference" Then

                 Debug.Print vModel.GetTitle, vFeat.Name, vFeat.GetTypeName

                 vFeat.Select False

              End If

              Set vFeat = vFeat.GetNextFeature

           Loop

           swApp.CloseDoc AsmFile

         End If

     End If

     Set swFeat = swFeat.GetNextFeature

  Loop

End Sub

********************

Sub fdsaffafdasfdasfdsafdasfdsafdewrqtq()

  ''

  Dim oDic As New Dictionary, Str

  ''

  Dim SwModel As ModelDoc2, swFeat As Feature, SwAssy As AssemblyDoc

  Set SwModel = Application.SldWorks.ActiveDoc

  Set SwAssy = SwModel

  Dim SwSelMgr As SelectionMgr, SwComp As Component2

  Dim SelArray(1 To 1)

  Set SwSelMgr = SwModel.SelectionManager

  Dim vChildComp, vComp As Component2

  Dim vModel As ModelDoc2, vFeat As Feature

  ''

  kk = 1

  Dim Rng As Range, oRng As Range, FindStr

    FileName = SwAssy.GetPathName

    Path = Left(FileName, InStrRev(FileName, "\"))

    FileName = Left(FileName, InStr(FileName, "卧式储罐") + 4) & "Horizontal Tank.xls"

    Set Sht = OpenXls(FileName).Sheets("材料表")

    Set oRng = Sht.Range("T:T")

  ''

    vChildComp = SwAssy.GetComponents(False)

    For ii = 0 To UBound(vChildComp)

       Set SwComp = vChildComp(ii)

       Set vModel = SwComp.GetModelDoc

       If Not vModel Is Nothing Then

         'If Not oDic.Exists(vModel.GetTitle) Then

           oDic(vModel.GetTitle) = ""

           'Debug.Print ii, kk, vModel.GetTitle, Space(2),

           Set Rng = oRng.Find(what:=vModel.GetTitle)

           If Not Rng Is Nothing Then

             sFileName = Path & Rng(1, 2)

             Debug.Print kk, sFileName, SwComp.GetPathName

             'boolstatus = SwComp.Select3(False, Nothing)

             SwComp.Select3 False, Nothing

             bRet = SwAssy.ReplaceComponents(sFileName, "", True, True)

             Set vModel = SwComp.GetModelDoc

             If Not IsEmpty(Rng(1, 3)) Then

                Debug.Print vModel.GetTitle, Rng(1, 3).Address

                RngReplaceEqu vModel, Rng(1, 3)

             End If

           End If

           kk = kk + 1

         'End If

       End If

    Next ii

End Sub