0 Replies Latest reply on Jul 20, 2017 11:50 AM by Korbi Anis

    select " PLANARSURFACE" and " 3DPROFILEFEATURE" in the tree manager

    Korbi Anis

      Hi friends ; I used this macro to traverse the tree manager and select " planarsurface " or " 3Dprofilefeature" if exist !

      the problem that when I run the macro it select " palanarsurface" onlu not twice !! whats the problem ? .thanks

      this is my macro :

       

       

      '=======================================================================================

      Sub deletesurfaceSKETCH()

      Dim swApp                       As SldWorks.SldWorks

          Dim swModel                     As SldWorks.ModelDoc2

          Dim swConfMgr                   As SldWorks.ConfigurationManager

          Dim swConf                      As SldWorks.Configuration

          Dim swRootComp                  As SldWorks.Component2

          Dim StartTime                   As Double

          Dim FinishTime                  As Double

          Dim TotalTime                   As Double

           Dim sPadStr                     As String

               Dim swSubFeat                   As SldWorks.Feature

          Dim swSubSubFeat                As SldWorks.Feature

          Dim swSubSubSubFeat             As SldWorks.Feature

          

          

          

          

          

          Set swApp = CreateObject("SldWorks.Application")

          Set swModel = swApp.ActiveDoc

          Set swConfMgr = swModel.ConfigurationManager

          Set swConf = swConfMgr.ActiveConfiguration

          Set swRootComp = swConf.GetRootComponent3(True)

          StartTime = Timer ' Start time

          Debug.Print "File = " & swModel.GetPathName

          TraverseModelFeatures swModel, 1

          If swModel.GetType = SwConst.swDocASSEMBLY Then

              TraverseComponent swRootComp, 1

       

       

          End If

          FinishTime = Timer ' End time

          TotalTime = FinishTime - StartTime ' Elapsed time

          Debug.Print ("Time = " & TotalTime & " sec")

         

          swModel.EditDelete

          swModel.ClearSelection2 True

         

          '================================================= SELECT SKETCH3D ==============================================================

       

      End Sub

      Sub TraverseFeatureFeatures(swFeat As SldWorks.Feature, nLevel As Long)

          Dim swSubFeat                   As SldWorks.Feature

          Dim swSubSubFeat                As SldWorks.Feature

          Dim swSubSubSubFeat             As SldWorks.Feature

       

       

         

          Dim sPadStr                     As String

          Dim i                           As Long

          For i = 0 To nLevel

              sPadStr = sPadStr + "  "

          Next i

          While Not swFeat Is Nothing

              Debug.Print sPadStr + swFeat.name + " [" + swFeat.GetTypeName + "]"

          

              Set swSubFeat = swFeat.GetFirstSubFeature

                 If swFeat.GetTypeName = "PlanarSurface" Then

      swFeat.Select True

       

       

      End If

            

              While Not swSubFeat Is Nothing

                  Debug.Print sPadStr + "  " + swSubFeat.name + " [" + swSubFeat.GetTypeName + "]"

                  Set swSubSubFeat = swSubFeat.GetFirstSubFeature

                   If swSubSubFeat.GetTypeName = "3DProfileFeature" Then

      swSubFeat.Select True

       

       

      End If

           While Not swSubSubFeat Is Nothing

                      Debug.Print sPadStr + "    " + swSubSubFeat.name + " [" + swSubSubFeat.GetTypeName + "]"

                      Set swSubSubSubFeat = swSubSubFeat.GetFirstSubFeature

                 

                      While Not swSubSubSubFeat Is Nothing

                          Debug.Print sPadStr + "      " + swSubSubSubFeat.name + " [" + swSubSubSubFeat.GetTypeName + "]"

                          Set swSubSubSubFeat = swSubSubSubFeat.GetNextSubFeature()

                      Wend

                      Set swSubSubFeat = swSubSubFeat.GetNextSubFeature()

                  Wend

                  Set swSubFeat = swSubFeat.GetNextSubFeature()

              Wend

              Set swFeat = swFeat.GetNextFeature

       

       

        Wend

       

       

      End Sub

      ============================================================================================

      Sub TraverseComponentFeatures(swComp As SldWorks.Component2, nLevel As Long)

          Dim swFeat As SldWorks.Feature

          Set swFeat = swComp.FirstFeature

          TraverseFeatureFeatures swFeat, nLevel

      End Sub

      ===========================================================================================

      Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

          Dim vChildComp                  As Variant

          Dim swChildComp                 As SldWorks.Component2

          Dim sPadStr                     As String

          Dim i                           As Long

         

          For i = 0 To nLevel - 1

              sPadStr = sPadStr + "  "

          Next i

          vChildComp = swComp.GetChildren

          For i = 0 To UBound(vChildComp)

              Set swChildComp = vChildComp(i)

              Debug.Print sPadStr & "+" & swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"

              TraverseComponentFeatures swChildComp, nLevel

              TraverseComponent swChildComp, nLevel + 1

       

       

          Next i

       

       

      End Sub

      ====================================================================================

      Sub TraverseModelFeatures(swModel As SldWorks.ModelDoc2, nLevel As Long)

          Dim swFeat As SldWorks.Feature

          Set swFeat = swModel.FirstFeature

          TraverseFeatureFeatures swFeat, nLevel

       

       

      End Sub