ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
DDDoleiman Doleiman10/10/2014

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 ?