I wrote the Macro below which works fine. Creates .pdf's for all sheets except .dxf and saves them in a given directory with a certain name.
Now the document management system of the firm has problems with color, so I need to save the .pdf's in black and white. How do I do that ?
Option Explicit
Dim PDFExpApp As SldWorks.SldWorks
Dim AppModel As SldWorks.ModelDoc2
Dim AppModelExt As SldWorks.ModelDocExtension
Dim AppDrawing As SldWorks.DrawingDoc
Dim AppExpData As SldWorks.ExportPdfData
Dim PathToPDF As String
Dim NameOfPDF As String
Dim SaveOfPDF As String
Dim ArrSheetNames As Variant
Dim strSheetNames() As String
Dim SheetName As Variant
Dim tempName As String
Dim bCheck As Boolean
Dim Err As Long
Dim War As Long
Sub main()
' Setzt Solidworks Dokument/Applikationsmodell
Set PDFExpApp = Application.SldWorks
PDFExpApp.Visible = True
Set AppModel = PDFExpApp.ActiveDoc
Set AppModelExt = AppModel.Extension
Set AppExpData = PDFExpApp.GetExportFileData(1)
' Abbruch bei nicht vorhandener Zeichnung oder falschem Dokumenttyp
If AppModel Is Nothing Then MsgBox "Zeichnung Öffnen Bitte. Danke!", vbCritical: End
If AppModel.GetType <> swDocDRAWING Then MsgBox ("Funktioniert nicht für Zeichnunge .dxf!"), vbCritical: End
' PDF Name und Pfad
PathToPDF = "C:\"
NameOfPDF = AppModel.GetTitle & ".pdf"
SaveOfPDF = PathToPDF & NameOfPDF
Call execute
End Sub
' Pfrüft alle Blätter der Zeichnung auf Dateiendung
' fügt alle nicht .dxf der ExportDaten hinzu
Sub execute()
Set AppDrawing = AppModel
' Set ArrSheetNames = AppDrawing.GetSheetNames
' Setzt Exporttyp auf .PDF
Set AppExpData = PDFExpApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)
ReDim strSheetNames(0)
' Alle Zeichnungsblätter ohne .dxf zusammenstellen
Dim s As Variant
For Each s In AppDrawing.GetSheetNames
If Not Format(s) Like "*.dxf*" Then
strSheetNames(UBound(strSheetNames)) = s
ReDim Preserve strSheetNames(UBound(strSheetNames) + 1)
End If
Next s
ArrSheetNames = strSheetNames
' ExportDaten setzen
bCheck = AppExpData.SetSheets(swExportData_ExportSpecifiedSheets, ArrSheetNames)
' ExportDaten speichern als .PDF
bCheck = AppModelExt.SaveAs(SaveOfPDF, 0, 0, AppExpData, Err, War)
End Sub
As far as I can tell, and this is the only thing I have ever done with the SW API, the SaveAs function does not have the option.
So maybe I can use a Print function insted ?