DXF-exportprobleem in een SolidWorks-macro

Macro
1

Hoi allemaal

Ik werk aan een SolidWorks-macro die DXF's exporteert. Mijn probleem is dat ik er alleen in geslaagd ben om het te laten werken door het plan te sluiten en het vervolgens opnieuw te openen voordat ik de export uitvoerde.

Ik was erin geslaagd om de dxf-opname aan het werk te krijgen zonder het plan te sluiten, maar het werkt maar één keer, bijvoorbeeld als ik de macro opnieuw opstart in een rij gaat het fout

Hier is het uittreksel van mijn macro, die echt veel andere dingen doet, maar hier zet ik je het exportgedeelte van de DXF

Bedankt

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

Je kunt deze optie nu al activeren (voor het geval dat)

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

En voor mijn functie gebruik ik meer saveas4 (jouw functie is achterhaald, net als saveas4 als ik de doc geloof):

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

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

1 like
3

@sbadenis is SaveAs4 net zo verouderd :wink: (maar verouderd betekent niet dat het niet meer werkt op macro's)
Tegenwoordig zijn de functies van IModelDocExtension en meer IModelDoc2 actief :slight_smile:

4

Ja @Cyril_f dat is wat ik zag en rechtzette in mijn bericht!

1 like