2 Replies Latest reply on Apr 29, 2014 8:16 AM by Mark Coville

    Delete Top Level Macro

    Mark Coville

      Hello,

       

      Does anyone have a macro that deletes the top level of what is selected. We just upgraded from SW2011 to SW2014 and this new delete functionality is not the best thing for us .(especially with EPDM) Here is what I have so far. I don't know how to select the top level of each component. Any help would be great

      Thanks,

       

       

      Dim swApp               As SldWorks.SldWorks
      Dim swModel             As SldWorks.ModelDoc2
      Dim swSelMgr            As SldWorks.SelectionMgr
      Dim swSelComp           As SldWorks.Component2
      Dim NewObjToSelect      As Object
      Dim GeneralSelObj       As Object
      Dim swParent            As Object
      Dim selObjectsCount     As Integer
      Dim i                   As Integer
      Dim CurSelCount         As Long
      Dim boolstatus          As Boolean

      Sub main()
      Set swApp = Application.SldWorks
      Set swModel = swApp.ActiveDoc
      Set swSelMgr = swModel.SelectionManager
      CurSelCount = 1
      selObjectsCount = swSelMgr.GetSelectedObjectCount
      For i = 1 To selObjectsCount
          Set GeneralSelObj = swSelMgr.GetSelectedObject(CurSelCount)
          Set swSelComp = swSelMgr.GetSelectedObjectsComponent(CurSelCount)
          Set NewObjToSelect = swSelComp.GetParent
          If Not NewObjToSelect Is Nothing Then
          swSelMgr.DeSelect CurSelCount
          bRet = NewObjToSelect.Select(True)
          Else
          CurSelCount = CurSelCount + 1
          End If
      Next
      End
      End Sub

        • Re: Delete Top Level Macro
          Artem Taturevych

          Hi Mark,

           

          Try this macro:

           

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swSelMgr As SldWorks.SelectionMgr

           

          Sub main()

           

              Set swApp = Application.SldWorks

           

              Set swModel = swApp.ActiveDoc

             

              Set swSelMgr = swModel.SelectionManager

             

              Dim swComp As SldWorks.Component2

             

              Dim i As Integer

             

              For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)

             

                  Set swComp = swSelMgr.GetSelectedObjectsComponent3(i, -1)

                 

                  If Not swComp Is Nothing Then

                 

                      Dim compsToDelColl As New Collection

                     

                      Dim swParentComp As SldWorks.Component2

                     

                      Set swParentComp = swComp

                     

                      While Not swParentComp Is Nothing

                          Set swComp = swParentComp

                          Set swParentComp = swComp.GetParent

                      Wend

                     

                      If Not CollectionContains(compsToDelColl, swComp) Then

                          compsToDelColl.Add swComp

                      End If

                     

                  End If

             

              Next

             

              swModel.ClearSelection2 True

             

              For i = 1 To compsToDelColl.Count

                  Set swComp = compsToDelColl.item(i)

                  swComp.Select4 True, Nothing, False

              Next

             

              swModel.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Children

             

          End Sub

           

          Function CollectionContains(coll As Collection, item As SldWorks.Component2) As Boolean

             

              Dim i As Integer

             

              For i = 1 To coll.Count

                 

                  If coll.item(i) Is item Then

                      CollectionContains = True

                      Exit Function

                  End If

             

              Next

             

              CollectionContains = False

             

          End Function

           

          ______________________________________________

          Regards, Artem Taturevych | Snr. Developer | IC3D ANZ

           

          IC3DSteel – New Steel Solution for SolidWorks

          translationXpert – SolidWorks files language translator

          LinkedIn - SolidWorks API Group