7 Replies Latest reply on Oct 26, 2017 11:28 AM by Matt Bieringer

    Pdf Export makro

    Jan Hallvard Myhren

      Hi,

      I have made a macro which creates PDF`s of my drawings.

       

      Our MPS system can only handle A3 as maximum sheet size,

      We are using A1 A2 formats on larger drawing`s.

       

      Is there a way to scale down the output format some how to A3?

       

      Regards

        • Re: Pdf Export makro
          Alex Burnett

          The only way I can think to do it is to use a macro to print the drawing and then select a PDF Converter as the printer. The page size can be specified before printing to match your A3 size requirement.

           

          Edit: Also this - Determining Sheet Size and Scale Via API

          • Re: Pdf Export makro
            Matt Bieringer

            Here is a quick macro I wrote up to allow you to print to pdf with A3 size paper. It will scale the drawing sheets to fit. You will need to modify the line where it selects the paper size. The best way to get this number is to start recording a macro, then go to File>Print, change the printer to your pdf printer, >Page Setup, change the paper size to A3 click OK on page setup and close on the print window and stop recording the macro.

            Print.PNGPage Setup.PNGPaper.PNG

            Open the macro you created and change the line to match.

             

            Sub main()
            Dim swApp                   As SldWorks.SldWorks
            Dim swModel                 As SldWorks.ModelDoc2
            Dim swDraw                  As SldWorks.DrawingDoc
            Dim swModelDocExt           As SldWorks.ModelDocExtension
            Dim swPrintSpec             As SldWorks.PrintSpecification
            Dim swPageSetup             As SldWorks.PageSetup
            Dim Printer                 As String
            Dim sheets(0)               As Long
            Set swApp = Application.SldWorks
            Set swModel = swApp.ActiveDoc
            Set swDraw = swModel
            Set swModelDocExt = swModel.Extension
            Set swPrintSpec = swModelDocExt.GetPrintSpecification
            Set swPageSetup = swModel.PageSetup
            swPrintSpec.RestoreDefaults
            swPrintSpec.ResetPrintRange
            swPageSetup.HighQuality = False
            swPrintSpec.ScaleMethod = 3
            swPageSetup.DrawingColor = 1
            swPageSetup.HighQuality = False
            swPrintSpec.ScaleMethod = swPrintAll
            Printer = "Adobe PDF"       'If you use a different PDF printer set the name here
            sheets(0) = 0      'Print all sheets
            swPageSetup.ScaleToFit = True
            If MsgBox("Do you want to print A3?", vbYesNo) = vbYes Then
                swPageSetup.PrinterPaperSize = 8       'Record a macro for your papersize and change the "8" to whatever the number is you get
                swModelDocExt.PrintOut3 sheets, 1, True, Printer, "", False
            End If
            swPrintSpec.RestoreDefaults
            swPrintSpec.ResetPrintRange
            End Sub
            
            • Re: Pdf Export makro
              Matt Bieringer

              Jan Hallvard Myhren

              So I have come up with a bit of a work around. The user will still have to save the pdf to a directory, but they will save it to C:\Temp, or whatever folder you want. At this point the macro will then print the pdf to the temp folder, then take the model custom properties for Revision and PartNo and rename and move the pdf to the Drawing Doc folder and delete the temp pdf. It will also overwrite an existing pdf with the same name.

               

              If you have any questions please let me know.

              I have attached the .swp along with posting the code itself. I hope this helps!

               

              Edit: forgot to mention, this will close any open windows of Adobe Acrobat. I did this because when I print using adobe it opens a new instance of Acrobat and it that is still open when I try to rename the file it will not succeed.

               

              Sub main()
              Dim acrobatID
              Dim swApp                   As SldWorks.SldWorks
              Dim swModel                 As SldWorks.ModelDoc2
              Dim swDraw                  As SldWorks.DrawingDoc
              Dim swSheet                 As SldWorks.Sheet
              Dim swView                  As SldWorks.View
              Dim swModelDocExt           As SldWorks.ModelDocExtension
              Dim swPrintSpec             As SldWorks.PrintSpecification
              Dim swPageSetup             As SldWorks.PageSetup
              Dim Printer                 As String
              Dim fName                   As String
              Dim pName                   As String
              Dim nPath                   As String
              Dim rev                     As String
              Dim sheets(0)               As Long
              Dim index                   As Integer
              Dim time1, time2
              Const Path                  As String = "C:\Temp\"
              Set swApp = Application.SldWorks
              Set swModel = swApp.ActiveDoc
              Set swDraw = swModel
              Set swSheet = swDraw.GetCurrentSheet
              Set swView = swDraw.GetFirstView
              Set swModelDocExt = swModel.Extension
              Set swPrintSpec = swModelDocExt.GetPrintSpecification
              Set swPageSetup = swModel.PageSetup
              nPath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") - 1)
              If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
              If swSheet.CustomPropertyView = "Default" Or swSheet.CustomPropertyView = "" Then
                  Set swView = swView.GetNextView
              Else
                  Do While swView.Name = swSheet.CustomPropertyView
                      Set swView = swView.GetNextView
                  Loop
              End If
              Set swModel = swView.ReferencedDocument
              pName = swModel.Extension.CustomPropertyManager("").Get("PartNo")
              rev = swModel.Extension.CustomPropertyManager("").Get("Revision")
              swPrintSpec.RestoreDefaults
              swPrintSpec.ResetPrintRange
              swPageSetup.HighQuality = False
              swPrintSpec.ScaleMethod = 3
              swPageSetup.DrawingColor = 1
              swPageSetup.HighQuality = False
              swPrintSpec.ScaleMethod = swPrintAll
              Printer = "Adobe PDF"
              sheets(0) = 0
              swPageSetup.ScaleToFit = True
              If MsgBox("Do you want to print A3?", vbYesNo) = vbYes Then
                  swPageSetup.PrinterPaperSize = 8
                  swModelDocExt.PrintOut3 sheets, 1, True, Printer, "", False
              End If
              swPrintSpec.RestoreDefaults
              swPrintSpec.ResetPrintRange
              time1 = Now
              time2 = Now + TimeValue("0:00:02")
              Do Until time1 >= time2
                  time1 = Now()
              Loop
              TerminateProcess
              fName = NewestFile(Path, "*.pdf")
              If Len(Dir$(nPath & pName & "_" & rev & ".pdf")) > 0 Then
                   Kill nPath & pName & "_" & rev & ".pdf"
              End If
              Name Path & fName As nPath & pName & "_" & rev & ".pdf"
              If Len(Dir$(Path & fName)) > 0 Then
                   Kill Path & fName
              End If
              End Sub
              Sub TerminateProcess()
                Dim strTerminateThis As String
                Dim objWMIcimv2 As Object
                Dim objProcess As Object
                Dim objList As Object
                Dim intError As Integer
                'Process to terminate
                strTerminateThis = "Acrobat.exe"
                'Connect to CIMV2 Namespace
                Set objWMIcimv2 = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
                'Find the process to terminate
                Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='" & strTerminateThis & "'")
                'Terminates a process and all of its threads.
                For Each objProcess In objList
                    intError = objProcess.Terminate
                Next
                Set objWMIcimv2 = Nothing
                Set objList = Nothing
                Set objProcess = Nothing
              End Sub
              Function NewestFile(Directory, FileSpec)
              ' Returns the name of the most recent file in a Directory
              ' That matches the FileSpec (e.g., "*.xls").
              ' Returns an empty string if the directory does not exist or
              ' it contains no matching files
                  Dim FileName As String
                  Dim MostRecentFile As String
                  Dim MostRecentDate As Date
                  If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
                  FileName = Dir(Directory & FileSpec, 0)
                  If FileName <> "" Then
                      MostRecentFile = FileName
                      MostRecentDate = FileDateTime(Directory & FileName)
                      Do While FileName <> ""
                          If FileDateTime(Directory & FileName) > MostRecentDate Then
                               MostRecentFile = FileName
                               MostRecentDate = FileDateTime(Directory & FileName)
                           End If
                           FileName = Dir
                      Loop
                  End If
                  NewestFile = MostRecentFile
              End Function