Makro Solidworks: Rysowanie do formatu PDF i DXF

Macro
1

Witam

Chcę utworzyć makro dla Solidworks, które przekształca arkusze rysunków w pliki PDF lub DXF.
Pliki PDF będą miały nazwę "nazwa pliku+nazwa arkusza"
Pliki DXF będą nazwane w ten sam sposób.

Makro musi rozróżniać arkusze, które mają zostać zapisane jako PDF lub DXF, zgodnie z obecnością lub brakiem słowa DXF w nazwie arkusza.

Poniżej znajduje się utworzone makro. Niestety pojawia się błąd "błąd kompilacji: Typ zdefiniowany przez użytkownika nie jest zdefiniowany".
Z zaznaczonym na niebiesko napisem "swExportDXFData As SldWorks.ExportDxfData".
Wydaje mi się, że rozumiem, że w odnośnikach brakuje jakiejś dane, ale jestem zagubiony.

Korzystam z SolidWorks 2022.

Czy ktoś mógłby mi pomóc?

Option Explicit

Sub ExportPDFandDXF()
    
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swSheet As SldWorks.Sheet
    Dim swExportData As SldWorks.ExportPdfData
    Dim swExportDXFData As SldWorks.ExportDxfData
    Dim sheetName As String
    Dim fileName As String
    Dim filePath As String
    Dim numSheets As Integer
    Dim i As Integer
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
        MsgBox "Aucun document ouvert dans SolidWorks."
        Exit Sub
    End If
    
    If Not swModel.GetType = swDocumentTypes_e.swDocDRAWING Then
        MsgBox "Ce n'est pas un document de mise en plan."
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    numSheets = swDraw.GetSheetCount
    
    fileName = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1)
    filePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))

    For i = 1 To numSheets
        
        Set swSheet = swDraw.Sheet(i)
        
        sheetName = swSheet.GetName
        
        If InStr(sheetName, "DXF") > 0 Then
            
            Set swExportDXFData = swApp.GetExportFileData(1)
            
            swExportDXFData.fileName = fileName & sheetName & ".dxf"
            swExportDXFData.SetSheets swSheet.GetName
            
            swModel.Extension.ExportToDWGDXF swExportDXFData
            
        Else
            
            Set swExportData = swApp.GetExportFileData(swExportPdfData)
            
            swExportData.fileName = fileName & sheetName & ".pdf"
            swExportData.SetSheets swSheet.GetName
            
            swModel.Extension.SaveAs swExportData
            
        End If
        
    Next i
    
    MsgBox "Exportation terminée."
    
End Sub
2

Witam
O ile się nie mylę, SldWorks.ExportDxfData nie istnieje, stąd błąd kompilacji.
Spójrz na ten temat , który jest identyczny

2 polubienia
3

Dziękuję za odpowiedź, ale nie mogę tego zrobić.
Próbowałem innego podejścia do sprawy i mam inny problem.

Chcę "tylko" zapisać arkusze rysunku w formacie .pdf lub .dxf w zależności od tego, czy słowo "DXF" występuje w nazwie zakładki (nazwa arkusza), ale wydaje mi się to zbyt skomplikowane.

Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim nomFeuille As String
Dim nomFichier As String
Dim dossier As String

Sub EnregistrerFeuilles()

    Set swApp = Application.SldWorks
    
    ' Vérifier si un document est ouvert
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "Ouvrir un document SolidWorks", vbExclamation, "Erreur"
        Exit Sub
    End If
    
    ' Vérifier si le document est une mise en plan
    If Not swModel.GetType = swDocDRAWING Then
        MsgBox "Le document actif n'est pas une mise en plan", vbExclamation, "Erreur"
        Exit Sub
    End If
    
    ' Récupérer le dossier et le nom du fichier
    dossier = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
    
    If InStrRev(swModel.GetTitle, ".") > 0 Then
        nomFichier = Mid(swModel.GetTitle, 1, InStrRev(swModel.GetTitle, ".") - 1)
    Else
        nomFichier = swModel.GetTitle
    End If
    
    ' Enregistrer chaque feuille en tant que fichier séparé
    Set swDraw = swModel
    If swDraw Is Nothing Then
        MsgBox "Le document actif n'est pas une mise en plan", vbExclamation, "Erreur"
        Exit Sub
    End If
    
    For Each swSheet In swDraw.Sheets
        nomFeuille = swSheet.GetName
        
        If InStr(1, nomFeuille, "DXF", vbTextCompare) > 0 Then
            swSheet.SaveAs dossier & nomFichier & " " & nomFeuille & ".dxf"
        Else
            swSheet.SaveAs dossier & nomFichier & " " & nomFeuille & ".pdf"
        End If
    Next
    
    MsgBox "Les feuilles ont été enregistrées", vbInformation, "Terminé"
    
End Sub

Z tym kodem mam nowy błąd:
row: Dla każdego arkusza swSheet w swDraw.GetSheets()

Kod błędu: 438
Właściwość lub metoda nieobsługiwana przez ten obiekt

Próbuję zdobyć kilka przykładów makro, które mi pomogą, ale kręcę się w kółko...

4

Witam

Istnieje wiele instrukcji, które nie istnieją w kodzie, a które wymagają aktywacji przed ich użyciem. Nie mam teraz czasu, żeby na to zajrzeć, może w poniedziałek, jeśli nikt inny nie przejdzie obok mnie w tym temacie.

1 polubienie
5

Witaj @stev7833 ,

Błąd kompilacji jest spowodowany faktem, że GetSheets nie jest metodą dokumentu rysunkowego. Lista arkuszy powinna być przeglądana przy użyciu ich nazw za pomocą GetSheetNames.

Co więcej, eksport rysunku arkusz po arkuszu w formacie pdf i dxf nie przebiega według tej samej logiki: struktura danych dla pierwszego (ExportPdfData), ustawienie opcji eksportu dla drugiego (swDxfMultiSheetOption, swDxfActiveSheetOnly).

W zasadzie sprzężenie makr powinno wykonać zadanie...

Pozdrowienia.
ExportMEPtoPdfDxf.swp (59,5 KB)

1 polubienie
6

Dzięki za info i makro,
Działa bardzo dobrze!