Print active drawings as a high quality png

HighQualityPng.swp

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExtension As ModelDocExtension


Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc


If swModel Is Nothing Then

 swApp.SendMsgToUser "This operation requires an active document"
 
 Exit Sub

End If



If swModel.GetType() <> SwConst.swDocumentTypes_e.swDocDRAWING Then

 swApp.SendMsgToUser "This operation requires an active drawing"
 
 Exit Sub

End If


'hide feature manager

Set swModelDocExtension = swModel.Extension

swModelDocExtension.HideFeatureManager True

'zoom to fit

swModel.ViewZoomtofit2


Dim printOrCapture As Long

printOrCapture = swApp.GetUserPreferenceIntegerValue(SwConst.swUserPreferenceIntegerValue_e.swTiffScreenOrPrintCapture)

Dim dpi As Long

dpi = swApp.GetUserPreferenceIntegerValue(SwConst.swUserPreferenceIntegerValue_e.swTiffPrintDPI)


' change capture method to print


swApp.SetUserPreferenceIntegerValue SwConst.swUserPreferenceIntegerValue_e.swTiffScreenOrPrintCapture, 1

' change the dpi to 2880


swApp.SetUserPreferenceIntegerValue SwConst.swUserPreferenceIntegerValue_e.swTiffPrintDPI, 2880

' prompt the user the save as dialog


swApp.RunCommand swCommands_e.swCommands_SaveAs, ""


' restore original value
swApp.SetUserPreferenceIntegerValue SwConst.swUserPreferenceIntegerValue_e.swTiffScreenOrPrintCapture, printOrCapture

swApp.SetUserPreferenceIntegerValue SwConst.swUserPreferenceIntegerValue_e.swTiffPrintDPI, dpi


End Sub