Ich habe dieses Makro ins Netz gebracht, um meine Zeichnungen direkt im PDF-Format zu speichern. Leider weiß ich als Anfänger auf diesem Gebiet nicht, wie ich den Pfad zum Datensatzordner meiner Zeichnungen hinzufügen soll.
Kann mir jemand sagen, wie ich vorgehen soll?
Hier ist das Makro, das ich gefunden habe, wenn es hilft, es funktioniert, aber PDFs im selben Ordner wie meine SW-Zeichnungen speichert.
Vielen Dank im Voraus!
Herzliche Grüße
Dimmen swApp als Objekt Sub main() Dim swApp als SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim swExportPDFData As SldWorks.ExportPdfData Dim strDateiname als Zeichenfolge Status dimmen: Als boolescher Wert Dimmfehler As Long, Warnungen As Long Legen Sie swApp = Application.SldWorks fest Festlegen von swModel = swApp.ActiveDoc "Retten status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, Fehler, Warnungen) 'Exportieren in PDF, wenn es sich um eine Zeichnung handelt Wenn (swModel.GetType = swDocDRAWING) dann strDateiname = swModel.GetPathName strDateiname = Links(strDateiname, Len(strDateiname) - 6) & "pdf" Set swExportPDFData = swApp.GetExportFileData(1) swModel.Extension.SaveAs strDateiname, 0, 0, swExportPDFData, 0, 0 Ende, wenn Ende Sub
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & « pdf »
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
Der Pfad befindet sich in einem Ordner, der dem Plan im PDF-Format gewidmet ist, der sich von dem im SW-Format unterscheidet. Aber mit der Zeit wird sich der Ort ändern, weil ich in Ordnern mit 1000 Plänen arbeite und es geht sehr schnell. (Ordner auf einem dedizierten Server)
Außerdem bin ich mir nicht sicher, ob ich verstanden habe, was ich im @sbadenis Makro tun sollte und wo ich meinen Pfad hinzufügen soll
Der Pfad wurde bereits fest hinzugefügt (zum Desktop) Wie möchten Sie Makros verwenden? Fall Nr. 1 Datei für Datei fragt Sie das Makro, ob Sie Ihre Datei in jeder Datei speichern möchten (was schnell Kopfschmerzen bereiten kann, wenn 100 Dateien gespeichert werden müssen) Fall Nr. 2 in einem Unterverzeichnis Ihrer Datei (immer identisch) Fall Nr. 3 (der, den ich ausgewählt hatte) auf dem Desktop (Falls notwendig, fügen Sie Maps/ hinter Desktop hinzu, um einen Ordner auf dem Desktop zu haben).
Ich habe einen PDF-Zeichnungsordner und darin habe ich mehrere Ordner, die in Schritten von 1000 PDF-Plänen angeordnet sind.
Beispiel:
1-1000
1001-2000
2001-3000
Ich denke, ich werde die Makroschaltfläche in meine Symbolleiste einfügen und sie wird an dem von mir gewählten Ort gespeichert und anschließend geändert.
Ich muss nur den Weg ins Büro durch den ersetzen, den ich will, wenn ich es richtig verstehe, werde ich es versuchen. Mein aktueller Pfad sieht folgendermaßen aus: O:\SolidWorks Datenbank\03-PDF-Bibliothek\18001-19000
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
Von ''' strDateiname = "O:\SolidWorks Base\03-PDF-Bibliothek\18001-19000" & strDateiname
Et le jour ou tu aura dépassé tes 1000 tu changes de nouveau cette ligne dans la macro
In der Tat Fehler es fehlte ein \ nach 19000, hier ist der Code geändert und vollständig und getestet:
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = "O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000\" & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
Außerdem muss der Ordner 18001-19000 bereits vorhanden sein, bevor Sie das Makro starten
Sie erhalten die 2 1. Ziffern und wir ändern den Namen des Ordners entsprechend. Es würde ein paar Zeilen Code hinzufügen, aber nichts Besonderes. Auf der anderen Seite müssen Sie die Datei auch erstellen, wenn sie nicht vorhanden ist.
Nein, bei mir ist es per Makro möglich, aber es würde ein paar Zeilen Code hinzufügen und man muss sicher sein, dass der Dateiname des MEP auch in den vom Ordner angegebenen Werten enthalten ist (Beispiel 18001.slddrw-> Ordner 18001-19000) Können Sie den genauen Namen einer Zeichnung als Beispiel nennen? Denn die Idee wäre, per Makro die 1. Ziffer abzurufen und diesen Ziffern folgend im vorhandenen Verzeichnis zu speichern oder den Ordner zu erstellen, wenn wir zu den nächsten Tausend gehen.
Hier ist der geänderte Code für die automatische Erstellung des Ordnernamens, wenn die MEps tatsächlich in dieser Form vorliegen: 18001.slddrw, 19000.slddrw oder 20000.slddrw...
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim FolderName As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
FolderName = Left(strFilename, Len(strFilename) - 7)
Debug.Print Right(FolderName, Len(FolderName) - 2)
If Right(FolderName, Len(FolderName) - 2) = "000" Then
'Si la MEP se termine par 000 on créer le dossier avec avec comme début de N° FolderName-1
FolderName = (Left(FolderName, Len(FolderName) - 3) - 1) & "001-" & (Left(FolderName, Len(FolderName) - 3)) & "000"
Else
'Si la MEP ne se termine pas par 000 on créer le dossier avec comme début de N° FolderName
FolderName = Left(FolderName, Len(FolderName) - 3) & "001-" & (Left(FolderName, Len(FolderName) - 3) + 1) & "000"
End If
FolderName = "O:\Base SolidWorks\03-Bibliothèque PDF\" & FolderName & "\"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(FolderName, vbDirectory + vbHidden) = "" Then
MkDir FolderName
End If
strFilename = FolderName & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
