Description
- Finds planes, axes, points, coordinate systems and sketches that nothing depends on.
- Lists them and deletes them after you confirm.
- The Front, Top and Right planes are always kept.
System Requirements
- SOLIDWORKS Version: SOLIDWORKS 2014 or newer
- Operating System: Windows 10 or later
Pre-Requisites
- The active document must be a part or an assembly.
Results
- Unused features are removed from the FeatureManager design tree.
- Use Undo if you need any of them back.
Steps to Set Up the Macro
- Open SOLIDWORKS and the document described in the pre-requisites.
- Create the macro
- Go to Tools > Macro > New, give the .swp file a name and save it. The VBA editor opens.
- Replace everything in the module with the code below.
- Run the macro
- Press F5 in the VBA editor, or use Tools > Macro > Run.
- For daily use, assign it to a toolbar button or keyboard shortcut via Tools > Customize.
VBA Macro Code
' Disclaimer:
' The code provided should be used at your own risk.
' Blue Byte Systems Inc. assumes no responsibility for any issues or damages that may arise from using or modifying this code.
' For more information, visit https://bluebyte.biz
' Reviewed and updated by Blue Byte Systems Inc.
Option Explicit
' Finds unused reference geometry and sketches (features with no children)
' in the active part or assembly, lists them and deletes them after confirmation.
' Types checked: planes, axes, points, coordinate systems, 2D and 3D sketches.
' The three default planes (Front, Top, Right) are always kept.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim vChildren As Variant
Dim found As New Collection
Dim label As String
Dim listText As String
Dim planeCount As Long
Dim i As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Open a part or assembly before running this macro.", vbExclamation
Exit Sub
End If
If swModel.GetType = swDocDRAWING Then
MsgBox "This macro works on parts and assemblies.", vbExclamation
Exit Sub
End If
Set swFeat = swModel.FirstFeature
Do While Not swFeat Is Nothing
label = ""
Select Case swFeat.GetTypeName2
Case "RefPlane"
planeCount = planeCount + 1
If planeCount > 3 Then label = "Plane" ' skip Front, Top, Right
Case "RefAxis": label = "Axis"
Case "RefPoint": label = "Point"
Case "CoordSys": label = "Coordinate system"
Case "ProfileFeature": label = "Sketch"
Case "3DProfileFeature": label = "3D sketch"
End Select
If label <> "" Then
vChildren = swFeat.GetChildren
If IsEmpty(vChildren) Then
found.Add swFeat
If found.Count <= 25 Then listText = listText & vbCrLf & swFeat.Name & " (" & label & ")"
End If
End If
Set swFeat = swFeat.GetNextFeature
Loop
If found.Count = 0 Then
MsgBox "No unused features found.", vbInformation
Exit Sub
End If
If found.Count > 25 Then listText = listText & vbCrLf & "... and " & (found.Count - 25) & " more"
If MsgBox(found.Count & " unused feature(s) found:" & vbCrLf & listText & vbCrLf & vbCrLf & _
"Delete them?", vbYesNo + vbQuestion) <> vbYes Then Exit Sub
swModel.ClearSelection2 True
For i = 1 To found.Count
found(i).Select2 True, -1
Next
swModel.Extension.DeleteSelection2 swDelete_Absorbed
swModel.ForceRebuild3 False
MsgBox found.Count & " feature(s) deleted. Use Undo if you need any back.", vbInformation
End Sub
Code Review Notes
We reviewed this macro before publishing it here. Changes from the original version:
- The original needed a separate UserForm that was not published with the code. It now runs from a single module.
- Works in assemblies as well as parts, and the default planes are protected.
Need to customize the macro?
Contact us and we will adapt this macro to your workflow, or build a complete SOLIDWORKS or PDM automation for your team.