Problem z eksportem DXF w makrze SolidWorks

Macro
1

Cze wszystkim

Pracuję nad makrem SolidWorks, które eksportuje pliki DXF. Mój problem polega na tym, że udało mi się sprawić, by to zadziałało, zamykając plan, a następnie otwierając go ponownie przed wykonaniem eksportu.

Udało mi się uruchomić nagranie dxf bez zamykania planu, ale działa tylko raz, na przykład, jeśli zrestartuję makro z rzędu, pójdzie nie tak

Oto fragment mojego makra, który naprawdę robi wiele innych rzeczy, ale tutaj umieszczam wam część eksportową DXF

Dziękuję

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

Możesz już aktywować tę opcję (na wszelki wypadek)

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

A dla mojej funkcji używam więcej saveas4 (twoja funkcja jest przestarzała, podobnie jak saveas4, jeśli wierzę w dokument):

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

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

1 polubienie
3

@sbadenis , SaveAs4 jest tak samo przestarzały :wink: (ale przestarzały nie oznacza, że nie działa już na makrach)
Obecnie aktywne są funkcje IModelDocExtension i więcej IModelDoc2 :slight_smile:

4

Tak , @Cyril_f to właśnie zobaczyłem i sprostowałem w moim poście!

1 polubienie