Macro Hole Removal Solidworks

Macro
1

Hello

I am a beginner in this field, as part of my internship I would like to make a macro in VBA that would remove the holes of a Solidworks part. To do this, I have written the following program:

Dim swApp As Object
Sub RemoveHoles()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeature As SldWorks.Feature

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swModel.GetType = swDocPART Then
    Set swFeature = swModel.FirstFeature
    Do While Not swFeature Is Nothing
        If swFeature.GetType = swHoleFeature Then
            swFeature.Select2 True, -1
            swModel.DeleteSelection2 swDelete_Absorbed
        End If
        Set swFeature = swFeature.GetNextFeature
    Loop
Else
    MsgBox "Le document actif n'est pas une pièce."
End If

End Sub

Sub main()

Set swApp = Application.SldWorks
RemoveHoles
End Sub

The program compiles without errors, however, when I run it, nothing happens. Thank you in advance for your help.

2

Hello
Welcome to the forum, as it stands, your code is incorrect on several parameters.
This type of code, removes all the tapping/drilling functions detected in the tree:

Dim swApp As Object
Sub RemoveHoles()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeature As SldWorks.Feature
Dim swFeature2 As SldWorks.Feature
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim bret As Boolean
Dim bDone As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
bDone = False

If swModel.GetType = swDocPART Then
    Set swFeature = swModel.FirstFeature
    Set swModelDocExt = swModel.Extension
    Do While Not swFeature Is Nothing
        If swFeature.GetTypeName2 = "HoleWzd" Then
            Set swFeature2 = swFeature
            Set swFeature = swFeature.GetNextFeature
            swFeature2.Select2 True, -1
            bDone = True
            bret = swModelDocExt.DeleteSelection2(swDelete_Absorbed)
        End If
        If Not bDone Then
        Set swFeature = swFeature.GetNextFeature
        End If
        bDone = False
    Loop
Else
    MsgBox "Le document actif n'est pas une pièce."
End If
End Sub

Sub main()

Set swApp = Application.SldWorks
RemoveHoles
End Sub

The main procedure is of little use at the moment, unless you want to use other features in the code.

2 Likes
3

Good evening, thank you for your welcome and your answer :slightly_smiling_face: