9 Replies Latest reply on Oct 18, 2011 1:14 PM by Deepak Gupta

    Sheet Format - Macro Question

    Roman Lech

      Here is a macro question

       

      I downloaded a macro that will change the sheet format in a given folder.  it works amazingly.  The only problem I am having with it is it will result in a default scale of 1:1 and it will not change the sheet format on other sheets of a document, only the current one. 

       

      I have posted the code below. 

       

       

      ' Change_Sheet_Format.swp ---------------------------------08/10/09

      ' Original Code taken from Zoom and Rebuild macro
      ' Author: Luke Malpass, Paul Kellner 2004 (super rebuild), Pete Farnham
      ' Website: http://www.angelsix.com

      ' Prerequisites: Set the directories having drawings you wish to run the
      ' change sheet format, set the new sheet format location and sheet format name
      '
      ' Macro will find all the drawing files in the specified folder/location and
      ' replace the existing sheet format with the new one. Might delete everything contained
      ' within the format.

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

      Option Explicit

      Dim swApp As SldWorks.SldWorks
      Dim swModel As ModelDoc2
      Dim swFilename As String
      Dim swDraw As SldWorks.DrawingDoc
      Dim swSheet As SldWorks.Sheet
      Dim bRet As Boolean
      Dim sPath As String
      Dim nErrors As Long
      Dim nWarnings As Long
      Dim Response As String
      Dim DocName As String
      ' Change sheet format location here

      Public Const sTemplatePath As String = "C:\Jobs 2010\Template\"


      Sub main()

      Set swApp = Application.SldWorks

      ' Change folder location containing the drawings to be updated here

      SheetFormat "C:\Jobs 2010\Job # 11068\06  REAR  Bowl Feeder\", ".SLDDRW", True

      End Sub

      Sub SheetFormat(folder As String, ext As String, silent As Boolean)

      Dim swDocTypeLong As Long

      ext = UCase$(ext)
      swDocTypeLong = Switch(ext = ".SLDDRW", swDocDRAWING, True, -1)

      'If not a SW file, return
      If swDocTypeLong = -1 Then
      Exit Sub
      End If

      ChDir (folder)

      Response = Dir(folder)
      Do Until Response = ""

      swFilename = folder & Response

      If Right(UCase$(Response), 7) = ext Then
       
        Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)
       
        If swDocTypeLong = swDocDRAWING Then
        
      Set swDraw = swModel
          Set swSheet = swDraw.GetCurrentSheet
          
      ' Change Sheet format name here which you to put on the drawing sheet.

      sPath = sTemplatePath & "RPP DRAWING.SLDDRT"

      bRet = swDraw.SetupSheet4(swSheet.GetName, swDwgPaperAsize, swDwgTemplateCustom, 1, 1, False, sPath, 0.2794, 0.2159, "Default")

          
        End If
       
        swModel.ViewZoomtofit2
       
        swModel.ForceRebuild3 False
       
        swModel.Save2 silent
       
        swApp.CloseDoc swModel.GetTitle
       
      End If

      Response = Dir
      Loop

      MsgBox "Drawing(s) Sheet Fomat Updated!!"

      End Sub

       

      Highlighted in green is the parameters that one would change  folder of template, folder to update drawings, and template name.  Whats in red is what I beleive makes the new scale 1:1

       

      I was hoping to find out if

      1: there is a way to have the scale the same as the original drawing after updating template, and

      2: (not necessary) have this macro update drawings with multiple sheets

       

      This macro is the work of

      Deepak Gupta (http://gupta9665.wordpress.com/)

       

      Any help would be much appreciated! 

       

      Thank you

        • Re: Sheet Format - Macro Question
          Deepak Gupta

          Welcome to SolidWorks forums Roman.

           

          You can edit the macro to get the scale for the sheet and then add codes for using those values (instead of 1:1) while it changes the sheet format. Also you can add the codes for going thru multiple sheets.

           

          You might also find this post helpful for your future reference

            • Re: Sheet Format - Macro Question
              Roman Lech

              do you have an idea of what code i would use?  i tried finding some sample code online without any luck.  Im not the most advanced when it comes to coding.  i beleive i came across a get sheet format code at one point but couldnt understand it.

               

              any help would be appreciated.  thank you

                • Re: Sheet Format - Macro Question
                  Roman Lech

                  i was tinkering a bit and this is what I came up with

                   

                  ' Change_Sheet_Format.swp ---------------------------------08/10/09

                  ' Original Code taken from Zoom and Rebuild macro
                  ' Author: Luke Malpass, Paul Kellner 2004 (super rebuild), Pete Farnham
                  ' Website: http://www.angelsix.com

                  ' Prerequisites: Set the directories having drawings you wish to run the
                  ' change sheet format, set the new sheet format location and sheet format name
                  '
                  ' Macro will find all the drawing files in the specified folder/location and
                  ' replace the existing sheet format with the new one. Might delete everything contained
                  ' within the format.

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

                  Option Explicit

                  Dim swApp As SldWorks.SldWorks
                  Dim swModel As ModelDoc2
                  Dim swFilename As String
                  Dim swDraw As SldWorks.DrawingDoc
                  Dim swSheet As SldWorks.Sheet
                  Dim bRet As Boolean
                  Dim sPath As String
                  Dim nErrors As Long
                  Dim nWarnings As Long
                  Dim Response As String
                  Dim DocName As String
                  Dim X As Double
                  Dim Y As Double

                  ' Change sheet format location here
                  Public Const sTemplatePath As String = "C:\Jobs 2010\Template\"

                  Sub main()

                  Set swApp = Application.SldWorks

                  ' Change folder location containing the drawings to be updated here
                  SheetFormat "C:\Documents and Settings\Design2\Desktop\TEST\", ".SLDDRW", True

                  End Sub


                  Sub SheetFormat(folder As String, ext As String, silent As Boolean)

                  Dim swDocTypeLong As Long
                  Dim vSheetProps As Variant

                  ext = UCase$(ext)
                  swDocTypeLong = Switch(ext = ".SLDDRW", swDocDRAWING, True, -1)

                  'If not a SW file, return
                  If swDocTypeLong = -1 Then
                  Exit Sub
                  End If

                  ChDir (folder)

                  Response = Dir(folder)
                  Do Until Response = ""

                  swFilename = folder & Response

                  If Right(UCase$(Response), 7) = ext Then
                   
                    Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)
                   
                    If swDocTypeLong = swDocDRAWING Then
                   
                    
                  Set swDraw = swModel

                      Set swSheet = swDraw.GetCurrentSheet
                     
                  vSheetProps = swSheet.GetProperties

                  ' Change Sheet format name here which you to put on the drawing sheet.


                  sPath = sTemplatePath & "RPP DRAWING.SLDDRT"

                  bRet = swDraw.SetupSheet4(swSheet.GetName, swDwgPaperAsize, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), False, sPath, 0.2794, 0.2159, "Default")

                      
                    End If
                   
                    swModel.ViewZoomtofit2
                   
                    swModel.ForceRebuild3 False
                   
                    swModel.Save2 silent
                   
                    swApp.CloseDoc swModel.GetTitle
                   
                  End If

                  Response = Dir
                  Loop

                  MsgBox "Drawing(s) Sheet Fomat Updated!!"

                  End Sub

                  It now runs but now the sheet format does not change and scale doesnt change (which is what I want) but am not sure if it actually works.  but it doesnt change to 1, 1,

                   

                  in bold is what was added to the code

                   

                  vSheetProps = swSheet.GetProperties

                   

                  Scale 1 is brought up by vSheetProps(2)

                  Scale2 is brought up by vSheetProps(3)

                   

                   

                  any help would be appreciated

                    • Re: Sheet Format - Macro Question
                      Deepak Gupta

                      You need to define the properties before calling them in the code.

                       

                      Add these line and check

                      ' Current sheet properties

                          Debug.Print "  Scale1                    = " & vSheetProps(2)

                          Debug.Print "  scale2                    = " & vSheetProps(3)

                      below the line

                      vSheetProperties = swSheet.GetProperties

                        • Re: Sheet Format - Macro Question
                          Roman Lech

                          GOT IT!

                           

                          ' Change_Sheet_Format.swp ---------------------------------08/10/09

                          ' Original Code taken from Zoom and Rebuild macro
                          ' Author: Luke Malpass, Paul Kellner 2004 (super rebuild), Pete Farnham
                          ' Website: http://www.angelsix.com

                          ' Prerequisites: Set the directories having drawings you wish to run the
                          ' change sheet format, set the new sheet format location and sheet format name
                          '
                          ' Macro will find all the drawing files in the specified folder/location and
                          ' replace the existing sheet format with the new one. Might delete everything contained
                          ' within the format.

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

                          Option Explicit

                          Dim swApp As SldWorks.SldWorks
                          Dim swModel As ModelDoc2
                          Dim swFilename As String
                          Dim swDraw As SldWorks.DrawingDoc
                          Dim swSheet As SldWorks.Sheet
                          Dim bRet As Boolean
                          Dim sPath As String
                          Dim nErrors As Long
                          Dim nWarnings As Long
                          Dim Response As String
                          Dim DocName As String


                          ' Change sheet format location here
                          Public Const sTemplatePath As String = "C:\Jobs 2010\Template\"

                          Sub main()

                          Set swApp = Application.SldWorks

                          ' Change folder location containing the drawings to be updated here
                          SheetFormat "C:\Documents and Settings\Design2\Desktop\TEST\", ".SLDDRW", True

                          End Sub

                          Sub SheetFormat(folder As String, ext As String, silent As Boolean)

                          Dim swDocTypeLong As Long
                          Dim vSheetProps As Variant


                          ext = UCase$(ext)
                          swDocTypeLong = Switch(ext = ".SLDDRW", swDocDRAWING, True, -1)

                          'If not a SW file, return
                          If swDocTypeLong = -1 Then
                          Exit Sub
                          End If

                          ChDir (folder)

                          Response = Dir(folder)
                          Do Until Response = ""

                          swFilename = folder & Response

                          If Right(UCase$(Response), 7) = ext Then
                           
                            Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)
                           
                            If swDocTypeLong = swDocDRAWING Then
                           

                             
                          Set swDraw = swModel
                              Set swSheet = swDraw.GetCurrentSheet

                          vSheetProps = swSheet.GetProperties



                          ' Change Sheet format name here which you to put on the drawing sheet.

                          sPath = sTemplatePath & "RP PRODUCTS.SLDDRT"

                          bRet = swDraw.SetupSheet4(swSheet.GetName, swDwgPaperAsize, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), False, sPath, 0.2794, 0.2159, "Default")

                              
                            End If
                           
                            swModel.ViewZoomtofit2
                           
                            swModel.ForceRebuild3 False
                           
                            swModel.Save2 silent
                           
                            swApp.CloseDoc swModel.GetTitle
                           
                          End If

                          Response = Dir
                          Loop

                          MsgBox "Drawing(s) Sheet Fomat Updated!!"

                          End Sub

                           

                           

                          WORKS GREAT,

                           

                          Added too much the first time, or messed something up.  What you just added was to display the scale, or print to screen or something. 

                           

                          What I did before seems to be right by defining

                          Dim vSheetProps As Variant

                          and adding

                          vSheetProps = swSheet.GetProperties

                           

                          bRet = swDraw.SetupSheet4(swSheet.GetName, swDwgPaperAsize, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), False, sPath, 0.2794, 0.2159, "Default")

                          I think I messed something up before, but works now .  Now to get it to scan multiple sheets, but that can wait

                           

                          CHEERS