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