AnsweredAssumed Answered

Macro to do Slddrw to PNG without background?

Question asked by Flemming Nielsen on Aug 18, 2014
Latest reply on Sep 15, 2014 by Daniel Andersson

Hi All,


I need a macro to export a PNG picture of a drawing, without background and preferably in a specific DPI.

I found a macro made by Deepak Gupta here

where I managed to get it saving a PNG, but still with a white background.


The code is;


Sub main()


Dim swApp                     As SldWorks.SldWorks

Dim swModel                   As SldWorks.ModelDoc2

Dim swSheet                   As SldWorks.Sheet

Dim vSheetNameArr, vSheetName As Variant

Dim bRet                      As Boolean

Dim lErrors                   As Long

Dim lWarnings                 As Long

Dim fileName                  As String

Dim strOriginallyActiveSheet  As String


Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc


' Is document active?


If swModel Is Nothing Then

    swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk

    Exit Sub

End If


' Is it a Drawing document?


If swModel.GetType <> swDocDRAWING Then

    swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk

    Exit Sub

End If


If swModel.GetTitle = "" Then

    swApp.SendMsgToUser2 "Save the Drawing first", swMbWarning, swMbOk

    Exit Sub

End If


fileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)

fileName = Left(fileName, InStrRev(fileName, ".") - 1)


'Change/Set DPI Settings and Paper Size here


swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swTiffPrintDPI, 300

swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swTiffPrintPaperSize, swDwgPaperSizes_e.swDwgPaperA4size


Set swSheet = swModel.GetCurrentSheet


strOriginallyActiveSheet = swSheet.GetName


vSheetNameArr = swModel.GetSheetNames


For Each vSheetName In vSheetNameArr


bRet = swModel.ActivateSheet(vSheetName): Debug.Assert bRet




swModel.Extension.SaveAs fileName + ".PNG", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings


Next vSheetName


swModel.ActivateSheet (strOriginallyActiveSheet)


End Sub