0 Replies Latest reply on Sep 19, 2013 8:24 PM by Yong Ning

    SwFeat.Select in AssemblyDoc

    Yong Ning

      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

      0.jpg

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

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

       

      1.jpg

       

      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