3 Replies Latest reply on Oct 10, 2014 3:00 AM by Deepak Gupta

    VBA - .pdf export - black and white (no color) - macro

    Doleiman Doleiman

      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 ?