Save Document As TIFF Example (VBA)

This example shows how to:

• Set TIFF export options

• Save the active document to a .tif format in the same directory.

 

'------------------------------------------------------------------

'

' Preconditions: Part, assembly, or drawing is open.

'

' Postconditions: TIFF file is saved to the same directory,

'           overwriting any existing file.

'

'------------------------------------------------------------------

Option Explicit

 

Public Enum swSaveAsVersion_e

    swSaveAsCurrentVersion = 0  '  default

    swSaveAsSW98plus = 1     '  save model in SOLIDWORKS 98plus model format - NO LONGER SUPPORTED

    swSaveAsFormatProE = 2  '  save SOLIDWORKS part as Pro/E format .prt or .asm extension (not as SOLIDWORKS .prt or .asm)

End Enum

Public Enum swSaveAsOptions_e

    swSaveAsOptions_Silent = &H1    '  Save document silently or not

    swSaveAsOptions_Copy = &H2  '  Save document as a copy or not

    swSaveAsOptions_SaveReferenced = &H4    '  Save referenced documents or not (drawings and parts only)

End Enum

Public Enum swFileSaveError_e

    swGenericSaveError = &H1

    swReadOnlySaveError = &H2

    swFileNameEmpty = &H4   '  The filename cannot be empty

    swFileNameContainsAtSign = &H8  '  The filename cannot contain the at-sign character (@)

    swFileLockError = &H10

    swFileSaveFormatNotAvailable = &H20 '  The Save As file type is not valid

    swFileSaveWithRebuildError = &H40   '  Not used in SOLIDWORKS 2001PLUS and beyond; moved to swFileSaveWarning_e

    swFileSaveAsDoNotOverwrite = &H80   '  The user chose not to overwrite an existing file

    swFileSaveAsInvalidFileExtension = &H100    '  The file extension differs from the SOLIDWORKS document type

End Enum

Public Enum swFileSaveWarning_e

    swFileSaveWarning_RebuildError = &H1    '  The file was saved, but with a rebuild error

End Enum

' swUserPreferenceToggle_e

Const swTiffPrintScaleToFit             As Long = 28

' swUserPreferenceIntegerValue_e

Const swTiffScreenOrPrintCapture        As Long = 6

Const swTiffImageType                   As Long = 7

Const swTiffCompressionScheme           As Long = 8

Const swTiffPrintDPI                    As Long = 9

Const swTiffPrintPaperSize              As Long = 10

Const swTiffPrintScaleFactor            As Long = 11

' swUserPreferenceDoubleValue_e

Const swTiffPrintDrawingPaperHeight     As Long = 8

Const swTiffPrintDrawingPaperWidth      As Long = 9

'  Tiff Image types

Public Enum swTiffImageType_e

    swTiffImageBlackAndWhite = 0

    swTiffImageRGB = 1

End Enum

'  Tiff Image Compression schemes

Public Enum swTiffCompressionScheme_e

    swTiffUncompressed = 0

    swTiffPackbitsCompression = 1

    swTiffGroup4FaxCompression = 2

End Enum

Public Enum swMessageBoxIcon_e

    swMbWarning = 1

    swMbInformation = 2

    swMbQuestion = 3

    swMbStop = 4

End Enum

Public Enum swMessageBoxBtn_e

    swMbAbortRetryIgnore = 1

    swMbOk = 2

    swMbOkCancel = 3

    swMbRetryCancel = 4

    swMbYesNo = 5

    swMbYesNoCancel = 6

End Enum

Public Enum swMessageBoxResult_e

    swMbHitAbort = 1

    swMbHitIgnore = 2

    swMbHitNo = 3

    swMbHitOk = 4

    swMbHitRetry = 5

    swMbHitYes = 6

    swMbHitCancel = 7

End Enum

Sub main()

    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim sPathName               As String

    Dim nRetVal                 As Long

    Dim nErrors                 As Long

    Dim nWarnings               As Long

    Dim bRet                    As Boolean

    

    Set swApp = CreateObject("SldWorks.Application")

    Set swModel = swApp.ActiveDoc

        

    ' dump current TIFF settings

    Debug.Print "PrintScaleToFit        = " + Str(swApp.GetUserPreferenceToggle(swTiffPrintScaleToFit))

    

    Debug.Print "ScreenOrPrintCapture   = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffScreenOrPrintCapture))

    Debug.Print "ImageType              = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffImageType))

    Debug.Print "CompressionScheme      = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffCompressionScheme))

    Debug.Print "PrintDPI               = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffPrintDPI))

    Debug.Print "PrintPaperSize         = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffPrintPaperSize))

    Debug.Print "PrintScaleFactor       = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffPrintScaleFactor))

    

    Debug.Print "DrawingPaperHeight     = " + Str(swApp.GetUserPreferenceDoubleValue(swTiffPrintDrawingPaperHeight))

    Debug.Print "DrawingPaperWidth      = " + Str(swApp.GetUserPreferenceDoubleValue(swTiffPrintDrawingPaperWidth))

    

    ' strip off SOLIDWORKS file extension (sld???)

    ' and add TIFF extension (tif)

    sPathName = swModel.GetPathName

    sPathName = Left(sPathName, Len(sPathName) - 6)

    sPathName = sPathName + "tif"

        

    bRet = swModel.SaveAs4(sPathName, _

            swSaveAsCurrentVersion, _

            swSaveAsOptions_Silent, _

            nErrors, _

            nWarnings)

    If bRet = False Then

        nRetVal = swApp.SendMsgToUser2("Problems saving file.", swMbWarning, swMbOk)

    End If

End Sub

'----------------------------------------------