3 Replies Latest reply on Sep 27, 2016 9:51 AM by Garret Hansen

    Rename current sheet to "DXF" and load DXF sheet format

    Garret Hansen

      Hello, I have a macro that quit working when I updated to SW 2016 SP4.  Some of my other very similar macros still work but this one does not.  This was a modification to one of Deepak Gupta's macros.

       

      What it does is it renames the currently selected sheet to DXF, it then loads a custom DXF sheet format and also sets the scale to 1:1.

       

      I can't figure out why it isn't working now that I have updated to SP4.  I get a Compile error: Object library feature not supported.

       

      Start of Code **************

       

      'DXF_Current_Sheet_Format.swp --------------------- 03/18/2015

      'Modified version of ----------- Reload Drawing Sheet Format.swp ------------- 06/05/14

       

      'Description: Macro to Set Drawing Sheet Format for current sheet to DXF.

      'Pre-Condition: An active drawing document having any sheet format.

      'Post-Condition: Macro will set the sheet format to DXF.

      'Might delete everything contained within the old/exisitng format.

      'Please back up your data before use and USE AT OWN RISK

      ' This macro is provided as is.  No claims, support, refund, safety net, or

      ' warranties are expressed or implied.  By using this macro and/or its code in

      ' any way whatsoever, the user and any entities which the user represents,

      ' agree to hold the authors free of any and all liability.  Free distribution

      ' and use of this code in other free works is welcome.  If any portion of

      ' this code is used in other works, credit to the authors must be placed in

      ' that work within a user viewable location (e.g., macro header).  All other

      ' forms of distribution (i.e., not free, fee for delivery, etc.) are prohibited

      ' without the expressed written consent by the authors.  Use at your own risk!

       

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

      ' Written by: Deepak Gupta (http://gupta9665.com/)

      ' Edited by Garret Hansen 03/18/2015

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

      'Option Explicit

       

      Sub main()

       

      Dim swApp           As SldWorks.SldWorks

      Dim swModel         As SldWorks.ModelDoc2

      Dim swDraw          As SldWorks.DrawingDoc

      Dim swSheet         As SldWorks.Sheet

       

      Dim vSheetProps     As Variant

      Dim vTemplateName   As Variant

      Dim sName           As String

       

      Dim nErrors         As Long

      Dim nWarnings       As Long

       

      ' Change sheet format location here

      Const sTemplatePath As String = "C:\RDIVault\ENGINEERING\SW TEMPLATES\"

      '***************************************

      Set swApp = Application.SldWorks

      Set swModel = swApp.ActiveDoc

       

      ' Check to see if a drawing is loaded.

      If swModel Is Nothing Then

              MsgBox "There is no active drawing document"

              Exit Sub

      End If

         

      If swModel.GetType <> swDocDRAWING Then

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

              Exit Sub

      End If

       

       

      Set swDraw = swModel

              Set swSheet = swDraw.GetCurrentSheet

              sName = "DXF"

              swSheet.SetName (sName)

              vTemplateName = "DXF-TBLK-in.slddrt"

              vSheetProps = swSheet.GetProperties

              vSheetProps(2) = 1

              vSheetProps(3) = 1

                      

          'Set the sheet format from the speicifed location

          swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), False, sTemplatePath & vTemplateName, vSheetProps(5), vSheetProps(6), "Default", True

          swDraw.ViewZoomtofit2

         

          swDraw.ForceRebuild3 False

          swDraw.Save3 1, nErrors, nWarnings

             

      Set swDraw = Nothing

       

      End Sub

       

      End of Code **************