AnsweredAssumed Answered

Macro to save drawing to single PDF and DXF to multiple sheet with Revision

Question asked by Remy Snippe on Jan 31, 2016
Latest reply on Oct 20, 2020 by Md Sobug Mia

Hi all,


Hope some of you are able to help me out with a macro.


Currently I am using two macro's. On to save a drawing to a PDF which includes the property 'Current Revision' in the Filename.


I got the Macro from this website and the only change I had to made was  the Propertyname of the Revision property.


This one runs great and the code is as following:




Sub main()


Dim swApp           As SldWorks.SldWorks

Dim swModel         As SldWorks.ModelDoc2

Dim swDrawModel     As SldWorks.ModelDoc2

Dim swDraw          As SldWorks.DrawingDoc

Dim swView          As SldWorks.View

Dim nErrors         As Long

Dim nWarnings       As Long

Dim Revision As String


Set swApp = Application.SldWorks

Set swDrawModel = swApp.ActiveDoc


If swDrawModel Is Nothing Then

        MsgBox "There is no active drawing document"

        Exit Sub

End If


If swDrawModel.GetType <> swDocDRAWING Then

        MsgBox "Open a drawing first and then TRY again!"

        Exit Sub

End If


Set swDraw = swDrawModel


Set swView = swDraw.GetFirstView

Set swView = swView.GetNextView

Set swModel = swView.ReferencedDocument


If swModel.GetPathName = "" Then

        MsgBox "Insert a View first and then TRY again!"

        Exit Sub

End If


    Revision = swModel.GetCustomInfoValue("", "Current revision")


    If Revision = "" Then


            Revision = ""




        Revision = "_" & Revision


    End If


swDraw.SaveAs3 Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, ".") - 1) & Prop & Revision & ".PDF", 0, 0


End Sub




The second one i use is one I also got from this site and I want to use it to save the drawing to DXF with different Sheets.


It is the following one but it does'nt include the Revision in the Filename. It is naming the file '002001-00-04023_-1_1.DXF' instead of '002001-00-04023_0-1_1.DXF' Note the revionnumber '0'in the filename.


The code is the following:




Sub main()


    Dim swApp                       As SldWorks.SldWorks

    Dim swModel                     As SldWorks.ModelDoc2

    Dim swDraw                      As SldWorks.DrawingDoc

    Dim vSheetName                  As Variant

    Dim nErrors                     As Long

    Dim nWarnings                   As Long

    Dim nRetval                     As Long

    Dim bShowMap                    As Boolean

    Dim nNumSheet                   As Long

    Dim i                           As Long

    Dim bRet                        As Boolean

    Dim FileName                    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



Set swDraw = swModel


' Rebuild the Drawing


    swDraw.ForceRebuild3 (False)


    vSheetName = swDraw.GetSheetNames


    For i = 0 To UBound(vSheetName)


    bRet = swDraw.ActivateSheet(vSheetName(i))


' Zoom to Fit the Sheet




'Set File Name Here


    FileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, ".") - 1) ' Strips off the file extension


    FileName = FileName & "_" & swModel.GetCustomInfoValue("", "Current revision") & "-" & i + 1 & "_" & swDraw.GetSheetCount


    bRet = swModel.SaveAs4(FileName & ".DXF", swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)


    Next i


' Switch back to first sheet


    bRet = swDraw.ActivateSheet(vSheetName(0))


End Sub





Now my questions are:


1. What is wrong in the DXF code that is failing to write the property 'Current revision' to the filename.


2 Is it possible to combine both macro's into one?


Hope you can help me out on this.


Kind regards


Remy Snippe