1 Reply Latest reply on Dec 7, 2013 7:00 PM by Yong Ning

    How to use FeatureByName in Traverse Assembly of subFeature?

    Yong Ning



      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 swFeat.Name

      End Sub

        • Re: How to Traverse Assembly of subFeature ?
          Yong Ning

          Help me




          select cc-1/dd-1(cc.sldasm/dd.sldprt)


          Set swFeat = swAssy.FeatureByName("cc-1/dd-1") → result is false.






          Private Sub TraverCompFeat()   


            Dim SwAssy As AssemblyDoc, SwFeat As Feature

            Dim Str, bRet As Boolean, sFileName

            Set SwAssy = Application.SldWorks.ActiveDoc

            'Debug.Print SwAssy.GetTitle


            'sFileName = "E:\MyWorkSummary\BESmodel\卧式储罐\贮罐V=50 Dn=2600\壳体Dn2600×26_L=8400.SldPrt"

            Set oDic = Nothing

            Set SwFeat = SwAssy.FirstFeature

            Do While Not SwFeat Is Nothing

              If SwFeat.GetTypeName = "Reference" Then

                Str = SwFeat.name

                Str = Left(Str, InStrRev(Str, "-") - 1) 

                If Not oDic.Exists(Str) Then

                  oDic(Str) = ""

                  If Str Like "*Shell*" Then

                    Debug.Print Str, SwFeat.GetTypeName

                    SwFeat.Select False

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

                    Debug.Print bRet

                  End If

                End If

                SwFeat.Select False

              End If

              Set SwFeat = SwFeat.GetNextFeature


          End Sub



          Sub main()

             Dim oDic As New Dictionary

             Dim swApp As SldWorks.SldWorks

             Dim swModel As SldWorks.ModelDoc2, vModel As ModelDoc2

             Dim swAssy As SldWorks.AssemblyDoc

             Dim swChildComp As SldWorks.Component2

             Dim vChildComp As Variant

             Dim boolstatus As Boolean

             Dim ii, Str, sFileName, Path: Path = "D:\Backup\我的文档\aa\"

             Dim swSelMgr As SelectionMgr, swFeat As Feature 

              Set swApp = CreateObject("SldWorks.Application")

              Set swModel = swApp.ActiveDoc

              Set swAssy = swModel   

              Set swSelMgr = swModel.SelectionManager         

              vChildComp = swAssy.GetComponents(False)

              For ii = 0 To UBound(vChildComp)

                 Set swChildComp = vChildComp(ii)

                 Set vModel = swChildComp.GetModelDoc

                 If Not vModel Is Nothing Then         

                    Str = vModel.GetTitle

                    If Not oDic.Exists(Str) Then

                      oDic(Str) = ""

                      Debug.Print ii, Str

                      boolstatus = swChildComp.Select3(False, Nothing)

                      sFileName = Str

                      If ii = 0 Then

                        sFileName = Path & "a.sldasm"

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

                      End If   

                    End If

                 End If

              Next ii

          End Sub



          See Attatch file .




          Private Sub fdsafdsafdsafd()
             Dim Wk As Workbook, tmpPath, modelPath
             Set Wk = connectXls
             tmpPath = Wk.Path & "\temp"
             modelPath = Wk.Path & "\baseModel"

              Dim Fso As Object
              'On Error Resume Next
              Set Fso = CreateObject("Scripting.FileSystemObject")
              Fso.CopyFile modelPath & "\*.*", tmpPath
              Dim swApp As SldWorks.SldWorks, SwDraw As DrawingDoc
              Set swApp = Application.SldWorks
              Dim longstatus As Long, longwarnings As Long
              Dim fileerror As Long, filewarning As Long, FileName
              FileName = tmpPath & "\Tank.SldDrw"
              'Set SwDraw = swApp.OpenDoc6("C:\360高速下载\卧式储罐\Temp\Tank.SldDrw", 3, 0, "", longstatus, longwarnings)
              Debug.Print FileName
              'Set SwDraw = swApp.OpenDoc6(FileName, 3, 0, "", longstatus, longwarnings)
              Set SwDraw = SwOpenFile(swApp, FileName)
          End Sub