Hallo
Willkommen im Forum 
Angehängt ist ein vorhandenes Makro
CitationSub ShowAllOpenFiles()
Dim swDoc As SldWorks.ModelDoc2
Dim swAllDocs As EnumDocuments2
Dimmen FirstDoc als SldWorks.ModelDoc2
Dummy als boolescher Wert dimmen
Dim NumDocsReturned As Long
DocCount so lange dimmen
Sonne i So lang
Dim sMsg As String
Dim swApp als SldWorks.SldWorks
Dim bDocWasVisible als boolescher Wert
Offene Warnungen so lange dimmen
OpenErrors so lange dimmen
Dim DwgPath als Zeichenfolge
Dimmen Sie myDwgDoc als SldWorks.ModelDoc2
Dim drwPathName als Zeichenfolge
Dim pdfPathName als Zeichenfolge
Dim pdfFolderName als Zeichenfolge
Dim swExportPDFData As SldWorks.ExportPdfData
Fehler so lange dimmen
Dim lWarnungen so lange
Dim boolstatus als boolescher Wert
Legen Sie swApp = Application.SldWorks fest
Legen Sie swAllDocs = swApp.EnumDocuments2 fest.
Legen Sie FirstDoc = swApp.ActiveDoc fest.
DocCount = 0
swAllDocs.Zurücksetzen
swAllDocs.Next 1, swDoc, NumDocsReturned
Während NumDocsReturned <> 0
bDocWasVisible = swDoc.Visible
‹ swApp.ActivateDoc swDoc.GetPathName ›
DwgPath = swDoc.GetPathName
if (LCase(Right(DwgPath, 3)) <> " drw ") und (DwgPath <> " ") dann
DwgPath = Links(DwgPfad, Len(DwgPfad) - 3) & " drw "
Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, " ", OpenErrors, OpenWarnings)
Wenn nicht, ist myDwgDoc nichts, dann
swApp.ActivateDoc myDwgDoc.GetPathName
pdfFolderName = "C:\pdf-Dateien"
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject(" Scripting.FileSystemObject ")
Wenn (Nicht fso. FolderExists(pdfFolderName)) dann
MkDir pdfOrdnerName
'MsgBox (pdfFolderName + " existiert nicht")
"U-Boot verlassen
Ende, wenn
Dimmteil als ModelDoc2
Set Part = swApp.ActiveDoc()
"Sie haben eine aktive Zeichnung
drwPathName = Teil.GetPathName()
Wenn (" " = drwPathName) dann
' GetPathName() war leer
MsgBox (" Diese Zeichnung wurde noch nicht gespeichert")
Sub beenden
Ende, wenn
pdfPfadName = fso. BuildPath(pdfFolderName, fso. GetBaseName(drwPathName) + " .pdf ")
Debuggen.pdfPfadname ausgeben
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = Falsch
Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings
'MsgBox (" PDF-Datei wurde erstellt ")
swApp.QuitDoc (Teil.GetTitle)
Legen Sie myDwgDoc = Nichts fest
Ende, wenn
Ende, wenn
swAllDocs.Next 1, swDoc, NumDocsReturned
DocCount = DocCount + 1
Wend
swApp.ActivateDoc FirstDoc.GetPathName
Ende Sub
pdf_des_composants_de_lassemblage.swp (54 KB)
0