Problem beim DXF-Export in einem SolidWorks Makro

Macro
1

Hallo ihr alle

Ich arbeite an einem SolidWorks Makro, das DXFs exportiert. Mein Problem ist, dass ich es nur geschafft habe, es zum Laufen zu bringen, indem ich den Plan geschlossen und dann erneut geöffnet habe, bevor ich den Export durchgeführt habe.

Ich hatte es geschafft, die DXF-Aufnahme zum Laufen zu bringen, ohne den Plan zu schließen, aber es funktioniert nur einmal, zum Beispiel, wenn ich das Makro hintereinander neu starte, wird es schief gehen

Hier ist der Auszug aus meinem Makro, das wirklich viele andere Dinge macht, aber hier habe ich Ihnen den Exportteil des DXF eingefügt

Vielen Dank

Function SaveDrawingAsDXF(swDrawing As ModelDoc2, saveFolderPath As String, value As String, indexValue As String) As String
    Dim dxfFileName As String
    Dim fullDXFPath As String
    Dim status As Boolean
    Dim lErrors As Long
    Dim lWarnings As Long
    Dim sheetNames As Variant
    Dim dxfSheetName As String
    Dim i As Integer
    Dim swModelDocExt As ModelDocExtension
    
    ' Formater le nom du fichier DXF avec l'extension en majuscules
    dxfFileName = UCase(Trim(value)) & "-" & Trim(indexValue) & ".DXF"
    fullDXFPath = saveFolderPath & dxfFileName

    ' Afficher le chemin pour débogage
    Debug.Print "Enregistrement DXF dans : " & fullDXFPath

    ' Vérifier que le document est bien actif
    If swDrawing Is Nothing Then
        MsgBox "Erreur : Aucun document actif.", vbExclamation
        SaveDrawingAsDXF = ""
        Exit Function
    End If

    Set swModelDocExt = swDrawing.Extension

    ' Récupérer les noms des feuilles
    sheetNames = swDrawing.GetSheetNames

    ' Chercher la feuille DXF
    dxfSheetName = ""
    For i = 0 To UBound(sheetNames)
        If InStr(LCase(sheetNames(i)), "dxf") > 0 Then
            dxfSheetName = sheetNames(i)
            Exit For
        End If
    Next i

    ' Si aucune feuille DXF trouvée, sortir de la fonction
    If dxfSheetName = "" Then
        SaveDrawingAsDXF = "" ' Sortir sans message ni erreur
        Exit Function
    End If

    ' Vérifier si le fichier DXF existe déjà et le supprimer
    If Dir(fullDXFPath) <> "" Then
        On Error Resume Next
        Kill fullDXFPath
        On Error GoTo 0
    End If

    ' Activer la feuille DXF
    swDrawing.ActivateSheet dxfSheetName

    ' Enregistrer le dessin en DXF
    status = swModelDocExt.SaveAs(fullDXFPath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, lErrors, lWarnings)

    If status = False Then
        MsgBox "Erreur lors de l'enregistrement du DXF : " & lErrors & " (Warnings: " & lWarnings & ")", vbExclamation
        SaveDrawingAsDXF = ""
    Else
        SaveDrawingAsDXF = fullDXFPath
    End If
End Function
2

Sie können diese Option bereits aktivieren (nur für den Fall)

  'On active l'option Exporter la feuille active uniquement pour dwg/dxf
  swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfActiveSheetOnly

Und für meine Funktion verwende ich saveas4 mehr (Ihre Funktion ist veraltet, ebenso wie saveas4, wenn ich dem Dokument glaube):

retval = Part.SaveAs4(Filepath & fileName & ".dxf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)

Speichern:
https://help.solidworks.com/2023/English/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IModelDocExtension~SaveAs.html?verRedire

1 „Gefällt mir“
3

@sbadenis ist SaveAs4 genauso veraltet :wink: (aber veraltet bedeutet nicht, dass es nicht mehr auf Makros funktioniert)
Heute sind die Funktionen von IModelDocExtension und mehr IModelDoc2 aktiv :slight_smile:

4

Ja @Cyril_f das habe ich in meinem Beitrag gesehen und korrigiert!

1 „Gefällt mir“