Makro-Lochentfernung Solidworks

Macro
1

Hallo

Ich bin Anfänger auf diesem Gebiet, im Rahmen meines Praktikums möchte ich ein Makro in VBA erstellen, das die Löcher eines Solidworks-Teils entfernt. Um dies zu tun, habe ich folgendes Programm geschrieben:

Dimmen swApp als Objekt
Sub RemoveHoles()
Dim swApp als SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeature als 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

Ende Sub

Sub main()

Legen Sie swApp = Application.SldWorks fest
Löcher entfernen
Ende Sub

Das Programm wird ohne Fehler kompiliert, aber wenn ich es ausführe, passiert nichts. Vielen Dank im Voraus für Ihre Hilfe.

2

Hallo
Willkommen im Forum, so wie es aussieht, ist Ihr Code bei mehreren Parametern falsch.
Diese Art von Code entfernt alle im Baum erkannten Tipp-/Bohrfunktionen:

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

Die Hauptprozedur ist im Moment von geringem Nutzen, es sei denn, Sie möchten andere Funktionen im Code verwenden.

2 „Gefällt mir“
3

Guten Abend, vielen Dank für Ihre Begrüßung und Ihre Antwort :slightly_smiling_face: