PDF-Makro muss bearbeitet werden

Hallo ihr alle

Ich habe ein Makro im Forum, um meine Solidworks MEPs im PDF-Format zu speichern, mein Problem ist, dass das Makro den Namen des PDFs ändert und das würde mir nicht gefallen.

Die Zeilen, die ich nicht brauche, habe ich schon gelöscht, aber gut ist es noch nicht...

Könnte bitte jemand das Makro so ändern, dass der Dateiname wie das MEP bleibt, ich möchte die 2 Speicherorte behalten.

Das Makro:

" Wir definieren die notwendigen Variablen
Dimmen swApp als Objekt
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim valOut1 As String
Dimmen valOut2 als Zeichenfolge
Dim valOut3 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 als Zeichenfolge
Dim resolvedValOut3 als Zeichenfolge
Pfad als Zeichenfolge dimmen
DimmpfadDesktop als Zeichenfolge
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName als Zeichenfolge
Dim nFileName2 als Zeichenfolge
Dim boolstatus als boolescher Wert
Fehler so lange dimmen
Dim lWarnungen so lange
Dim lgFile As Integer

Sub main()
" Wir halten an Solidworks fest
Legen Sie swApp = Application.SldWorks fest

" Wir rufen das aktive Dokument in Solidworks ab
Festlegen von swModel = swApp.ActiveDoc

" Wir überprüfen, ob ein Dokument in Solidworks geöffnet ist
Wenn swModel nichts ist, dann
    MsgBox "Ein Dokument muss in Solidworks aktiv sein.", vbCritical
    Ende
Ende, wenn

" Wir überprüfen, ob es sich bei dem in Solidworks geöffneten Dokument um einen Plan handelt
Wenn swModel.GetType <> swDocDRAWING dann
    MsgBox "Das aktive Dokument in Solidworks muss ein Plan sein.", vbCritical
    Ende
Ende, wenn

" Wir überprüfen, ob der offene Plan in Solidworks gespeichert ist
Wenn swModel.GetPathName = "" Dann
    swModel.Speichern
Ende, wenn

' Wir rufen den Pfad des Planregistrierungsordners ab
Pfad = swModel.GetPathName
lgFile = InStrRev(Pfad, "\", -1, vbTextCompare) - 1
Wenn lgFile > 0 ist, dann
    Pfad = Links(Pfad, lgDatei)
Ende, wenn

" Wir stellen den Pfad des Windows-Desktops wieder her
PfadDesktop = Über("BENUTZERPROFIL") & "\Desktop"

' Wir definieren die Exportparameter im PDF-Format
Legen Sie swModelDocExt = swModel.Extension fest
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = Falsch

' Wir definieren den Pfad und den Namen der ersten zu erstellenden PDF-Datei
nFileName = Pfad & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " - Ind." & resolvedValOut3 & " - " & dateNow & ".PDF"

' Speichern Sie die erste PDF-Datei
boolstatus = swModelDocExt.SaveAs(nDateiname, 0, 0, swExportPDFData, lFehler, lWarnungen)

' Wir definieren den Pfad und den Namen der zweiten zu erstellenden PDF-Datei
nFileName2 = PathDesktop & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " - Ind." & resolvedValOut3 & " - " & dateNow & ".PDF"

' Wir speichern die zweite pdf-Datei
boolstatus = swModelDocExt.SaveAs(nDateiname2, 0, 0, swExportPDFData, lFehler, lWarnungen)

Ende Sub

Vielen Dank im Voraus.

 

Hallo, testen Sie dieses.

Mit geringer Genauigkeit werden die PDF- und DWG-Dateien an der gleichen Stelle wie die letzte Aufnahme gespeichert. Im Klartext, bevor Sie Marco  ausführen, speichern Sie Ihren Plan , indem Sie file=> speichern unter ausführen und dann das Makro ausführen

Möge die Macht mit dir sein


macro_pdf_-dwg.swp
3 „Gefällt mir“

Sie verpassen offensichtlich nicht viel, fügen Sie einfach eine debug.print hinzu, um die Werte Ihrer Variablen zu sehen:

 

' On définit les variables nécessaires
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim valOut1 As String
Dim valOut2 As String
Dim valOut3 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim resolvedValOut3 As String
Dim Path As String
Dim PathDesktop As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim nFileName2 As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long
Dim lgFichier As Integer

Sub main()
' On se raccroche à Solidworks
Set swApp = Application.SldWorks

' On récupère le document actif dans Solidworks
Set swModel = swApp.ActiveDoc

' On vérifie qu'un document est bien ouvert dans Solidworks
If swModel Is Nothing Then
    MsgBox "Un document doit être actif dans Solidworks.", vbCritical
    End
End If

' On vérifie que le document ouvert dans Solidworks est un plan
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Le document actif dans Solidworks doit être un plan.", vbCritical
    End
End If

' On vérifie que le plan ouvert dans Solidworks est bien enregistré
If swModel.GetPathName = "" Then
    swModel.Save
End If

' On récupère le chemin du dossier d'enregistrement du plan
Path = swModel.GetPathName
lgFichier = InStrRev(Path, "\", -1, vbTextCompare) - 1
If lgFichier > 0 Then
    Path = Left(Path, lgFichier)
End If

' On récupère le chemin du bureau Windows
PathDesktop = Environ("USERPROFILE") & "\Desktop"

' On définit les paramètres d'export en PDF
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False

' On définit le chemin et le nom du premier fichier pdf à créer
nFileName = Path & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " - Ind." & resolvedValOut3 & " - " & dateNow & ".PDF"
Debug.Print "nFileName=" & nFileName

' On sauvegarde le premier fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

' On définit le chemin et le nom du deuxième fichier pdf à créer
nFileName2 = PathDesktop & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " - Ind." & resolvedValOut3 & " - " & dateNow & ".PDF"
Debug.Print "nFileName2=" & nFileName2

' On sauvegarde le deuxième fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)

End Sub

 

Dann bearbeiten Sie Ihr Makro, Sie fügen Sie das Ausführungsfenster hinzu, Sie führen Ihr Makro aus und Sie schauen sich den Wert Ihrer Eigenschaft an und Sie werden sehen, ob es einen Fehler in Ihrem Pfad gibt (für mich liegt das Problem in der Verkettung Ihrer Variablen Dateiname1 und 2)

Wenn der Wert Ihrer Variablen nicht gültig ist oder unzulässige Zeichen enthält, wird sie nicht aufgezeichnet.

Darüber hinaus verwenden Sie in Ihrer Verkettung die Variablen resolvedValOut1, 2 und 3, die so deklariert sind, wie sie in der Zeichenfolge sein sollten, die aber in Ihrem Makro nicht zu finden sind, also leer!

 

 

2 „Gefällt mir“

Hallo

Von dem, was ich verstehe, denke ich, dass der folgende Code es erfüllt.

' On définit les variables nécessaires
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim valOut1 As String
Dim valOut2 As String
Dim valOut3 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim resolvedValOut3 As String
Dim Path As String
Dim PathDesktop As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim nFileName2 As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long
Dim lgFichier As Integer

Sub main()
' On se raccroche à Solidworks
Set swApp = Application.SldWorks

' On récupère le document actif dans Solidworks
Set swModel = swApp.ActiveDoc

' On vérifie qu'un document est bien ouvert dans Solidworks
If swModel Is Nothing Then
    MsgBox "Un document doit être actif dans Solidworks.", vbCritical
    End
End If

' On vérifie que le document ouvert dans Solidworks est un plan
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Le document actif dans Solidworks doit être un plan.", vbCritical
    End
End If

' On vérifie que le plan ouvert dans Solidworks est bien enregistré
If swModel.GetPathName = "" Then
    swModel.Save
End If

' On récupère le chemin du dossier d'enregistrement du plan
Path = swModel.GetPathName
lgFichier = InStrRev(Path, "\", -1, vbTextCompare) - 1
If lgFichier > 0 Then
    Path = Left(Path, lgFichier)
End If

' On récupère le chemin du bureau Windows
PathDesktop = Environ("USERPROFILE") & "\Desktop"

' On définit les paramètres d'export en PDF
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False

' On définit le chemin et le nom du premier fichier pdf à créer
nFileName = left(Path, len(Path)-6) & "PDF" 'Retrait de l'extension SW en gardant le point et ajout PDF

' On sauvegarde le premier fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

' On définit le chemin et le nom du deuxième fichier pdf à créer
nFileName2 = Mid(Path, InStrRev(Path, "\") + 1) 'purge le chemin d'accès du fichier d'origine
nFileName2 = PathDesktop & left(nFileName2, len(nFileName2)-6) & "PDF"

' On sauvegarde le deuxième fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)

End Sub

 

2 „Gefällt mir“

@ OBI WAN
Danke für das Makro, ich werde es unter meinem Gürtel behalten.

@Cyril.f

Makro funktioniert nicht :-(

@ sbadenis

"Darüber hinaus verwenden Sie in Ihrer Verkettung die Variablen resolvedValOut1, 2 und 3, die so deklariert sind, wie sie in der Zeichenkette sein sollten, die aber in Ihrem Makro nicht gefunden werden, also leer!"

Ja, seine Variablen sind für mich nicht nützlich, ich hatte die Funktionen im obigen Makro entfernt, aber diese belassen, weil ich nicht wusste, was ich ersetzen sollte, um es mit dem gleichen Namen wie meine MAP zu speichern.

Aber plötzlich funktioniert auch Ihr Makro nicht mehr.

2 „Gefällt mir“

Hallo

Ich habe ein funktionales Makro, um die Zeichnungen im PDF-Format zu erstellen

Ich schicke es Ihnen, es läuft derzeit auf SOLIDWORKS 2016

Ich lasse Sie es ändern, wenn nötig

 


enregistrement_pdf.swp
1 „Gefällt mir“

Wenn Sie debug.print eingeben und sich die Werte ansehen, hätten Sie den Fehler von @Cyril.f finden können, indem Sie ein wenig gesucht haben.

Hier ist der funktionale Code mit der debug.print, schauen Sie sich an, wie er im Ausführungsfenster aussieht, und wenn Sie möchten, können Sie sie kommentieren oder nicht, da sie ein kleines Makro wie dieses nicht wirklich belasten.

' On définit les variables nécessaires
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim Path As String
Dim PathDesktop As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim nFileName2 As String
Dim FileName As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

'Dim lgFichier As Integer

Sub main()
' On se raccroche à Solidworks
Set swApp = Application.SldWorks

' On récupère le document actif dans Solidworks
Set swModel = swApp.ActiveDoc

' On vérifie qu'un document est bien ouvert dans Solidworks
If swModel Is Nothing Then
    MsgBox "Un document doit être actif dans Solidworks.", vbCritical
    End
End If

' On vérifie que le document ouvert dans Solidworks est un plan
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Le document actif dans Solidworks doit être un plan.", vbCritical
    End
End If

' On vérifie que le plan ouvert dans Solidworks est bien enregistré
If swModel.GetPathName = "" Then
    swModel.Save
End If

' On récupère le chemin du dossier d'enregistrement du plan
Path = swModel.GetPathName

    
'on récupère le chemin complet sans le nom de fichier
FilePath = Left(Path, InStrRev(Path, "\"))
'Debug.Print "Filepath:" + Filepath
    
        
'on récupère le nom du fichier sans l'extension
FileName = Mid(Path, Len(FilePath) + 1, Len(Path) - (7 + Len(FilePath)))
' on affiche la variable dans la fenêtre Exécution
Debug.Print "FileName=" & FileName

' on affiche la variable dans la fenêtre Exécution
Debug.Print "Path=" & Path
lgFichier = InStrRev(Path, "\", -1, vbTextCompare) - 1
If lgFichier > 0 Then
    Path = Left(Path, lgFichier)
End If

' On récupère le chemin du bureau Windows
PathDesktop = Environ("USERPROFILE") & "\Desktop"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "PathDesktop=" & PathDesktop

' On définit les paramètres d'export en PDF
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False

' On définit le chemin et le nom du premier fichier pdf à créer
'nFileName = Left(Path, Len(Path) - 6) & "PDF" 'Retrait de l'extension SW en gardant le point et ajout PDF
nFileName = FilePath & FileName & ".pdf"

' on affiche la variable dans la fenêtre Exécution
Debug.Print "nFileName=" & nFileName
' On sauvegarde le premier fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

' On définit le chemin et le nom du deuxième fichier pdf à créer
'nFileName2 = PathDesktop & Left(nFileName2, Len(nFileName2) - 6) & "PDF"
nFileName2 = PathDesktop & "\" & FileName & ".pdf"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "nFileName2=" & nFileName2
' On sauvegarde le deuxième fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)

End Sub

 

 

2 „Gefällt mir“

@sbadenis

Das Makro ist auch perfekt, vielen Dank!

Hallo, könnten Sie mir bitte dieses Makro schicken?

Den Code für das Makro finden Sie in dem Beitrag, der das Thema gelöst hat.
Erstellen Sie einfach ein neues Makro, und fügen Sie den Code darin ein.

Erstellen Sie bei Bedarf ein Thema (mit dem zugehörigen Thema), anstatt ein altes Thema auszugraben.

3 „Gefällt mir“