Macro suppression de trou solidworks

Macro
1

Bonjour,

Je suis débutante dans ce domaine, dans le cadre de mon stage je souhaiterais réaliser une macro en VBA qui supprimerait les trous d’une pièce Solidworks. Pour cela j’ai rédigé le programme suivant :

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

Le programme se compile sans erreurs cependant quand je l’exécute rien ne se passe. Je vous remercie d’avance pour votre aide.

2

Bonjour,
Bienvenue sur le forum, en l’état votre code est incorrect sur plusieurs paramètres.
Ce type de code, supprime toutes les fonctions de taraudage/perçage détectées dans l’arbre:

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

La procédure main ne sert pas à grand chose pour le moment, à moins que vous ne souhaitiez utiliser d’autres fonctionnalités dans le code.

2 « J'aime »
3

Bonsoir, merci pour votre accueil ainsi que votre réponse :slightly_smiling_face: