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 https://forum.solidworks.com/message/385536?sr=search&searchId=9c5b419d-93e7-41af-9c5a-923a03005185&searchIndex=0#385536

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.ViewZoomtofit2

 

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

 

Next vSheetName

 

swModel.ActivateSheet (strOriginallyActiveSheet)

 

End Sub

Outcomes