Macro to delete tree features
Macro to delete tree features
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
Thanks
Dwight
Re: Macro to delete tree features
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
'--------------------------------------
' 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
Re: Macro to delete tree features
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
'**********************
'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
Re: Macro to delete tree features
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
Dwight
- AlexLachance
- Posts: 2226
- Joined: Thu Mar 11, 2021 8:14 am
- Location: Quebec
- x 2419
- x 2061
Re: Macro to delete tree features
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
Re: Macro to delete tree features
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
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
- Posts: 2226
- Joined: Thu Mar 11, 2021 8:14 am
- Location: Quebec
- x 2419
- x 2061
Re: Macro to delete tree features
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 deletedDwight wrote: ↑Fri Oct 25, 2024 10:34 am 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
Re: Macro to delete tree features
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
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
Re: Macro to delete tree features
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
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
Re: Macro to delete tree features
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.
- Attachments
-
- DeleteSelectedFeatures.swp
- (57.5 KiB) Downloaded 147 times
Re: Macro to delete tree features
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.
Dwight
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.
Dwight
Re: Macro to delete tree features
You would need to change the macro reference libraries to suit your SW version. Check this video
Deepak Gupta
SOLIDWORKS Consultant/Blogger
SOLIDWORKS Consultant/Blogger
Re: Macro to delete tree features
Thanks, Deepak. That worked fine.
And thanks very much AlexB. This will save me a lot of frustration.
Dwight
And thanks very much AlexB. This will save me a lot of frustration.
Dwight