7 Replies Latest reply on Dec 1, 2017 11:56 AM by Gordon Smithjes

    Macro for changing sheet format

    Gordon Smithjes

      Dear Users,

       

      i checked the macros from Axel Hedman

      But the macro's aint doing what i like to see.

       

      I get lots of drawings from our client a we have to put on our own sheet formats for the right data for the factory.

      what i like to see in the macro is:

       

      that the current open sheet wil get the new sheetformat "sheet-A3.slddrt" with the same scale and as the curent open sheet.

       

      Thanks for your time.

        • Re: Macro for changing sheet format
          John Stoltzfus

          Did you try #Task?  Or contact Deepak Gupta ??

          • Re: Macro for changing sheet format
            Gordon Smithjes

            yes i did.

             

            i also change the sheetmane and location like they sayd.

            • Re: Macro for changing sheet format
              Deepak Gupta

              Gordon, try the macro posted here Batch Reload Drawing Sheet Format

               

              The macro would update all drawings (single or multiple sheets) in the selected folder. You'll have to change the sheet format path, name and paper size(s) in the macro.

               

              For single active file, try the macro from this post https://forum.solidworks.com/message/432563#comment-432563

               

              You will have to modify the sheet format path and name.

              • Re: Macro for changing sheet format
                Gordon Smithjes

                What i doing wrong in this code

                "S:\Otab\01 TEMPLATES\"  is my directory for the slddrt files

                "Otab.slddrt"  is the file which i want to get as my new sheet format.

                 

                still get a blank drawingNieuwe bitmapafbeelding.bmp

                 

                 

                'Batch Drawing Sheet Format Update.swp ------------- 10/10/13

                 

                 

                'Description: Macro to change/update Drawing Files Sheet Format for all sheets.

                 

                 

                'Pre-Condition: Specify the Sheet format path and Sheet format name in the macro.

                ' The drawing sheet format name should not be same as exisitng sheet format on drawings.

                 

                 

                'Post-Condition: 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 old/exisitng format.

                 

                 

                'Folder Browse Codes: http://www.cpearson.com/excel/browsefolder.aspx

                 

                 

                '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/)

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

                Option Explicit

                Private Const BIF_RETURNONLYFSDIRS As Long = &H1

                Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

                Private Const BIF_RETURNFSANCESTORS As Long = &H8

                Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

                Private Const BIF_BROWSEFORPRINTER As Long = &H2000

                Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

                Private Const MAX_PATH As Long = 260

                Function BrowseFolder(Optional Caption As String, _

                    Optional InitialFolder As String) As String

                 

                 

                Dim SH As Shell32.Shell

                Dim F As Shell32.Folder

                 

                 

                Set SH = New Shell32.Shell

                Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)

                If Not F Is Nothing Then

                    BrowseFolder = F.Items.Item.Path

                End If

                 

                 

                End Function

                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 vSheetName      As Variant

                 

                 

                Dim longstatus      As Long

                Dim longwarnings    As Long

                Dim nErrors         As Long

                Dim nWarnings       As Long

                Dim i               As Long

                 

                 

                Dim sFileName       As String

                Dim Path            As String

                 

                 

                ' Change sheet format location here

                'Make sure to include \ at the end of the path like show in the given path below

                Const sTemplatePath As String = "S:\Otab\01 TEMPLATES\"

                 

                 

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

                Const sTemplateName As String = "Otab.slddrt"

                 

                 

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

                 

                 

                On Error Resume Next

                 

                 

                Set swApp = Application.SldWorks

                         

                    Path = BrowseFolder()

                    If Path = "" Then

                   

                    MsgBox "Please select the path and try again"

                    End

                    Else

                   

                    Path = Path & "\"

                    End If

                       

                    sFileName = Dir(Path & "*.slddrw")

                    Do Until sFileName = ""

                    Set swModel = swApp.OpenDoc6(Path & sFileName, swDocDRAWING, swOpenDocOptions_Silent, "", longstatus, longwarnings)

                    Set swModel = swApp.ActiveDoc

                   

                    vSheetName = swModel.GetSheetNames

                 

                 

                For i = 0 To UBound(vSheetName)

                 

                 

                        swModel.ActivateSheet vSheetName(i)

                        Set swSheet = swModel.GetCurrentSheet

                        vSheetProps = swSheet.GetProperties

                   

                    swModel.SetupSheet4 swSheet.GetName, vSheetProps(0), swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), False, sTemplatePath & sTemplateName, 0.297, 0.42, "Default"

                    swModel.ViewZoomtofit2

                   

                Next i

                 

                 

                 

                 

                    swModel.ActivateSheet vSheetName(0)

                    swModel.ForceRebuild3 False

                    swModel.Save3 1, nErrors, nWarnings

                    swApp.CloseDoc swModel.GetTitle

                   

                Set swModel = Nothing

                  

                sFileName = Dir

                  

                Loop

                 

                 

                End Sub

                • Re: Macro for changing sheet format
                  Gordon Smithjes

                  i did send you the code

                  • Re: Macro for changing sheet format
                    Gordon Smithjes

                    problem solved by using teamviewer and the assistant of the programmer Deepak.

                    in 5 min the macro was edit and tested.

                     

                    thanks to Deepak we now save a lot of time