Macro to delete tree features

[Dwight]

I'd like a macro I can use to select tree features and delete them. I do not want it to guess which ones I really want to delete, I would like it to go ahead and delete them without making a fuss. And it would be extra special if it did not delete tree features I didn't select.

Thanks

Dwight

[Dwight]

So there's this, but it seems to delete only one feature no matter how many I have selected. I need some sort of loop?

'--------------------------------------
' Preconditions:
' 1. Open a model document.
' 2. Select the feature to delete.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Deletes the selected feature.
' 2. Examine the Immediate window, graphics
' area, and FeatureManager design tree.
'--------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim DeleteOption As Long
Dim status As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swModelDocExt = swModel.Extension
' To delete absorbed features, use enum swDeleteSelectionOptions_e.swDelete_Absorbed
' To delete children features, use enum swDeleteSelectionOptions_e.swDelete_Children
' To keep absorbed features and children features, set DeleteOption = 0
DeleteOption = swDeleteSelectionOptions_e.swDelete_Absorbed

'Comment out the previous statement and uncomment one of the
'following statements to change how to delete the selected feature
'DeleteOption = swDeleteSelectionOptions_e.swDelete_Children
'DeleteOption = 0
'DeleteOption =swDeleteSelectionOptions_e.swDelete_Absorbed + swDeleteSelectionOptions_e.swDelete_Children
status = swModelDocExt.DeleteSelection2(DeleteOption)
Debug.Print "Feature deleted? " & status
End Sub

[Dwight]

This thing only does a folder full of features. Why a folder? Anyway, maybe I can edit that part out (maybe get rid of all the blank lines, too).

'**********************
'Copyright(C) 2024 Xarial Pty Limited
'Reference: https://www.codestack.net/solidworks-ap ... -children/
'License: https://www.codestack.net/license/
'**********************

Const SHOW_CONFIRMATION_DIALOG As Boolean = True

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

If Not swModel Is Nothing Then

Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = swModel.SelectionManager

Dim swFolderFeat As SldWorks.Feature

Set swFolderFeat = swSelMgr.GetSelectedObject6(1, -1)

If Not swFolderFeat Is Nothing Then

If swFolderFeat.GetTypeName2() = "FtrFolder" Then

Dim vFeats As Variant
vFeats = GetFeaturesInFolder(swFolderFeat)
Dim i As Integer

If Not IsEmpty(vFeats) Then
For i = 0 To UBound(vFeats)
Dim swFeat As SldWorks.Feature
Set swFeat = vFeats(i)
swFeat.Select2 True, -1
Next
End If

If SHOW_CONFIRMATION_DIALOG Then

Dim featNames As String

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

On Error Resume Next

Set swFeat = swSelMgr.GetSelectedObject6(i, -1)
If Not swFeat Is Nothing Then
featNames = featNames & vbCrLf & swFeat.Name
End If

Next

If swApp.SendMsgToUser2( _
"Delete the following feature(s) and all absorbed features?" & vbCrLf & featNames, _
swMessageBoxIcon_e.swMbQuestion, _
swMessageBoxBtn_e.swMbYesNo) = swMessageBoxResult_e.swMbHitNo Then
End
End If
End If

swModel.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Absorbed

Else
MsgBox "Selected feature is not a folder"
End If

Else
MsgBox "Please select folder feature"
End If

Else
MsgBox "Please open model"
End If

End Sub

Function GetFeaturesInFolder(folderFeat As SldWorks.Feature) As Variant

Const FOLDER_CLOSE_TAG As String = "___EndTag___"

Dim swFeatsColl As Collection
Set swFeatsColl = New Collection

Dim swNextFeat As SldWorks.Feature

Set swNextFeat = folderFeat.GetNextFeature

Dim nestedFolderLevel As Integer
nestedFolderLevel = 0

While Not swNextFeat Is Nothing

Dim isEndFolderTagFeat As Boolean
isEndFolderTagFeat = False

If swNextFeat.GetTypeName2() = "FtrFolder" Then

isEndFolderTagFeat = Right(swNextFeat.Name, Len(FOLDER_CLOSE_TAG)) = FOLDER_CLOSE_TAG

If isEndFolderTagFeat Then
If nestedFolderLevel = 0 Then
GetFeaturesInFolder = CollectionToArray(swFeatsColl)
Exit Function
Else
nestedFolderLevel = nestedFolderLevel - 1
End If
Else
nestedFolderLevel = nestedFolderLevel + 1
End If

End If

If Not isEndFolderTagFeat Then
If Not Contains(swFeatsColl, swNextFeat) Then
swFeatsColl.Add swNextFeat
End If

CollectAllSubFeatures swNextFeat, swFeatsColl
End If

Set swNextFeat = swNextFeat.GetNextFeature

Wend

End Function


Sub CollectAllSubFeatures(swFeat As SldWorks.Feature, coll As Collection)

Dim swSubFeat As SldWorks.Feature
Set swSubFeat = swFeat.GetFirstSubFeature

While Not swSubFeat Is Nothing

If Not Contains(coll, swSubFeat) Then
coll.Add swNextFeat
End If

CollectAllSubFeatures swSubFeat, coll
Set swSubFeat = swSubFeat.GetNextSubFeature

Wend

End Sub

Function Contains(coll As Collection, item As Object) As Boolean

Dim i As Integer

For i = 1 To coll.Count
If coll.item(i) Is item Then
Contains = True
Exit Function
End If
Next

Contains = False

End Function

Function CollectionToArray(coll As Collection) As Variant

If coll.Count() > 0 Then

Dim arr() As Object

ReDim arr(coll.Count() - 1)
Dim i As Integer

For i = 1 To coll.Count
Set arr(i - 1) = coll(i)
Next

CollectionToArray = arr

Else
CollectionToArray = Empty
End If

End Function

[Dwight]

It's been too long since I've tried to do a macro. If this takes only a couple minutes for someone who knows what they are doing, I'd really appreciate it.

Dwight

[AlexLachance]

I'm not sure I understand what you are trying to accomplish Dwight? You want something that deletes what you selected, why not delete it "manually" by pressing "delete"..? Is it that it deletes other features in the tree? If so, you want to uncheck "Delete child features" in the delete confirmation box

image.png (19.85 KiB) Viewed 1465 times

[Dwight]

Alex

I find that the manual delete function for tree features will do only a small subset of the features I select, and often it will delete features I don't select. If I uncheck "Delete child features" then it will delete even fewer features and still delete features I have not selected and do that unpredictably. If I select "Yes to All" it will do more but far fewer than all.

I do injection molded parts and often have a long feature tree. Also I do concept development for new parts, often new products, so I often want to hack away huge chunks of features while I try to preserve a set of features late in the model. This morning I was doing just this and could only get there in about 20 steps. And that doesn't count the times I had step backwards and try again in order to prevent the features I wanted from disappearing. It is really quite frustrating.

I can't imagine more people don't complain about this. If what I describe here doesn't seem realistic, I could make a video of it.

Dwight

[AlexLachance]

Alex

I find that the manual delete function for tree features will do only a small subset of the features I select, and often it will delete features I don't select. If I uncheck "Delete child features" then it will delete even fewer features and still delete features I have not selected and do that unpredictably. If I select "Yes to All" it will do more but far fewer than all.

I do injection molded parts and often have a long feature tree. Also I do concept development for new parts, often new products, so I often want to hack away huge chunks of features while I try to preserve a set of features late in the model. This morning I was doing just this and could only get there in about 20 steps. And that doesn't count the times I had step backwards and try again in order to prevent the features I wanted from disappearing. It is really quite frustrating.

I can't imagine more people don't complain about this. If what I describe here doesn't seem realistic, I could make a video of it.

Dwight

That's intriguing, I'd love a video of the issue or a sample part that I could test to see if I get the same result on my end, I don't think I've ever had things selected to delete not be deleted

[AlexB]

I don't necessarily see an issue with your macro, other than it operates the same as the delete dialog from within SW when you manually try to delete multiple things.

The main issue is when you try to delete a feature and another feature that is dependent on the one being deleted. This, for whatever reason, causes the delete dialog to de-select the conflicting items.

The best I could recommend is to go through one by one and try and delete it as a single selection. See below for modified macro code:
Disclaimer: I didn't test this much so it could still break in some scenarios

Code: Select all

'--------------------------------------
' Preconditions:
' 1. Open a model document.
' 2. Select the feature to delete.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Deletes the selected feature.
' 2. Examine the Immediate window, graphics
' area, and FeatureManager design tree.
'--------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim seSelMgr As SelectionMgr
Dim DeleteOption As Long
Dim status As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swModelDocExt = swModel.Extension
Set swSelMgr = swModel.SelectionManager
' To delete absorbed features, use enum swDeleteSelectionOptions_e.swDelete_Absorbed
' To delete children features, use enum swDeleteSelectionOptions_e.swDelete_Children
' To keep absorbed features and children features, set DeleteOption = 0
DeleteOption = swDeleteSelectionOptions_e.swDelete_Absorbed

'Comment out the previous statement and uncomment one of the
'following statements to change how to delete the selected feature
'DeleteOption = swDeleteSelectionOptions_e.swDelete_Children
'DeleteOption = 0
'DeleteOption =swDeleteSelectionOptions_e.swDelete_Absorbed + swDeleteSelectionOptions_e.swDelete_Children

Dim selections() As Variant
Dim selectionTypes() As Variant
Dim selectionCount As Integer

selectionCount = swSelMgr.GetSelectedObjectCount

If selectionCount < 1 Then Exit Sub

ReDim selections(selectionCount - 1)
ReDim selectionTypes(selectionCount - 1)

Dim i As Integer
For i = 0 To selectionCount - 1
    Set selections(i) = swSelMgr.GetSelectedObject6(i + 1, -1)
    selectionTypes(i) = swSelMgr.GetSelectedObjectType3(i + 1, -1)
Next i

If Not IsEmpty(selections) Then
    For i = 0 To UBound(selections)
        'If selectionTypes(i) = swSelectType_e.swSelBODYFEATURES Then  ' You can enable filtering on the selections to only delete certain types
            swModel.ClearSelection2 True
            Dim selectedFeature As Feature
            Set selectedFeature = selections(i)
            selectedFeature.Select False
            swModelDocExt.DeleteSelection2 DeleteOption
        'End If
    Next i
End If

Debug.Print "Feature deleted? " & status

End Sub

[Dwight]

AlexB

Thanks very much. It is kind of slow, but that's fine because it doesn't stop for prompts, which means I can go do something else while it's working. Very useful.

Dwight

[AlexB]

It is kind of slow...

I suppose it probably rebuilds between each delete, which is not really fun. The attached version listens for events to halt rebuild during deletion and only rebuilds once at the end.

[Dwight]

AlexB

The second version didn't seem to run. In the editor, it didn't compile. I've no idea why, since the "swApp As SldWorks.SldWorks" looks the same as in your first version. But I don't know what I am looking for.

AlexL

I made a video of my experience with deleting.

delete.mp4

(24.33 MiB) Downloaded 55 times

Dwight

[gupta9665]

You would need to change the macro reference libraries to suit your SW version. Check this video

[Dwight]

Thanks, Deepak. That worked fine.

And thanks very much AlexB. This will save me a lot of frustration.

Dwight