6 Replies Latest reply on Feb 28, 2018 2:06 PM by Matt Peneguy

    Macro will not run from shortcut on toolbar

    Eric Schwieterman

      I have a macro that is updating the sheet format of drawings.  I can run the macro by hitting "run macro" on the toolbar and browsing to the macro file and it runs fine.  When I put it on the toolbar as its own macro button it will not run.  No errors or anything, it just does nothing.  Has anyone seen this before?

        • Re: Macro will not run from shortcut on toolbar
          Matt Peneguy

          Care to post the macro?  It's hard to diagnose without seeing the code.

            • Re: Macro will not run from shortcut on toolbar
              Eric Schwieterman

              Sure no problem.  Here's the code:

               

               

               

               

              Dim msgtext(6) As String    ' some texts for multi-language support

                  Dim sheetformatpath(12) As String

                  Dim sheetformatdirasm As String

                  Dim sheetformatdirmach As String

               

                 

              Sub main()

               

               

              Dim swApp      As New SldWorks.SldWorks

              Dim swModel    As SldWorks.ModelDoc2

              Set swModel = swApp.ActiveDoc

               

               

                 

                  ' Path to directory with sheetformats

                  sheetformatdirasm = "C:\Engineering\SolidWorks Admin\01 Document Templates\Drawing Assembly\"

                  sheetformatdirmach = "C:\Engineering\SolidWorks Admin\01 Document Templates\Drawing Machining\"

                 

                  sheetformatpath(0) = sheetformatdirasm & "A Assembly Landscape.slddrt"

                  sheetformatpath(1) = sheetformatdirasm & "A Assembly Portrait.slddrt"

                  sheetformatpath(2) = sheetformatdirasm & "B Assembly Landscape.slddrt"

                  sheetformatpath(3) = sheetformatdirmach & "A Machining Landscape.slddrt"

                  sheetformatpath(4) = sheetformatdirmach & "A Machining Portrait.slddrt"

                  sheetformatpath(5) = sheetformatdirmach & "B Machining Landscape.slddrt"

                 

               

               

                  'Dim swApp As Object

                  Dim DrawingDoc As Object

                  Dim Sheet As Object

                 

                  Dim Titel As String

                  Dim Datei As String

                  Dim temp As String

                  Dim pfad As String

                  Dim msgtxt As String

                 

                  Dim Name As String

                  Dim paperSize As Long

                  Dim templateIn As Long

                  Dim scale1 As Double

                  Dim scale2 As Double

                  Dim firstAngle As Boolean

                  Dim templateName As String

                  Dim Width As Double

                  Dim Height As Double

                  Dim propertyViewName As String

               

               

                  Dim i As Long

                  Dim AnzahlBl As Long

                  Dim SheetNames As Variant

                  Dim SheetProperties As Variant

                 

                  Const swDocDRAWING = 3

                  Const swDwgTemplateCustom = 12

                  Const swDwgTemplateNone = 13

               

               

                  ' attach to SolidWorks

                  Set swApp = CreateObject("SldWorks.Application")

                 

                  Set DrawingDoc = swApp.ActiveDoc

                  If DrawingDoc Is Nothing Then

                      ' check if document is open

                      MsgBox msgtext(0)

                      Exit Sub

                  End If

                 

                  If (DrawingDoc.GetType <> swDocDRAWING) Then

                      ' check if document is a drawing

                      MsgBox msgtext(1)

                      Exit Sub

                  End If

               

               

                  ' get sheet count and traverse all sheets to reload sheetfromat

                  AnzahlBl = 1 'DrawingDoc.GetSheetCount

                  SheetNames = DrawingDoc.GetSheetNames

               

               

                  ' reset error messages

                  msgtxt = ""

                 

                  For i = 0 To AnzahlBl - 1

                      ' activate next sheet

                      If DrawingDoc.ActivateSheet(SheetNames(i)) Then

                          ' attach to sheet object

                          Set Sheet = DrawingDoc.GetCurrentSheet

                          SheetProperties = Sheet.GetProperties

                         

                          ' first we have to set the sheet to use "no sheetformat", for SolidWorks

                          ' wont reload a sheetformat if it is the same name as before

                          Name = Sheet.GetName

                          paperSize = SheetProperties(0)

                          ' set NO SHEETFORMAT

                          templateIn = swDwgTemplateNone

                          scale1 = SheetProperties(2)

                          scale2 = SheetProperties(3)

                          firstAngle = CBool(SheetProperties(4))

                          ' no sheetformat = no path

                          templateName = ""

                          ' but we need the sheet siz

                          Width = SheetProperties(5)

                          Height = SheetProperties(6)

                          propertyViewName = Sheet.CustomPropertyView

                         

                          retval = DrawingDoc.SetupSheet4( _

                                      Name, _

                                      paperSize, _

                                      templateIn, _

                                      scale1, _

                                      scale2, _

                                      firstAngle, _

                                      templateName, _

                                      Width, _

                                      Height, _

                                      propertyViewName)

                          If retval = False Then

                              msgtxt = msgtxt & msgtext(2) & vbCrLf

                          Else

                         

                              ' and now we set the new sheetformat; it is necessary to set

                              ' USER DEFINIED sheetformat for SolidWorks will look for the

                              ' standard templates temp_??.slddrt in your specified folder

                              ' if using the standard sheet sizes.

                              templateIn = swDwgTemplateCustom

                             

                              ' get correct sheetformat for this size depending on the

                              ' papersize, this will allow aleady userdefined sheetformats

                              ' to properly be reloaded

                              paperSize = GetSheetSizeFromPaperSize(Width, Height)

                              templateName = sheetformatpath(paperSize)

                             

                              retval = DrawingDoc.SetupSheet4( _

                                          Name, _

                                          paperSize, _

                                          templateIn, _

                                          scale1, _

                                          scale2, _

                                          firstAngle, _

                                          templateName, _

                                          Width, _

                                          Height, _

                                          propertyViewName)

                              If retval = False Then

                                  ' ERROR : can't load new sheetformat

                                  msgtxt = msgtxt & msgtext(3) & templateName & vbCrLf

                              Else

                                 

                                  ' everything worked fine, no message here for automation

                                 

                                  ' save the document without backup

                                  If DrawingDoc.Save2(True) > 0 Then

                                      ' error saving file

                                      msgtxt = msgtxt & msgtext(5) & vbCrLf

                                  End If

                             

                              End If

                         

                          End If

                      Else

                          msgtxt = msgtxt & msgtext(4) & Name & vbCrLf

                      End If

                  Next i

               

               

                  If Len(msgtxt) Then

                      'MsgBox msgtxt

                  End If

               

               

              End Sub

               

               

              Private Sub CheckLanguage()

               

               

                  Case Else

                      ' english is default

                      msgtext(0) = "Nothing opened, so what should I look at?"

                      msgtext(1) = "Only useful with drawing"

                      msgtext(2) = "*** ERROR: can't reset sheet "

                      msgtext(3) = "*** ERROR: can't set new sheetformat for drawing. Sheetformat file exists? "

                      msgtext(4) = "*** ERROR: cant activate sheet "

                      msgtext(5) = "*** ERROR: cant save document "

                      msgtext(6) = "Please edit macro first (Extras/Macros/Edit)"

                  End Select

               

               

              End Sub

               

               

              Function GetSheetSizeFromPaperSize(SheetWidth, SheetHeight)

                  ' Function returns the SheetSize constant based on the width and heigth

                  ' useful for userdefined sheetformats

                 

                  Const swDwgPaperAsize = 0

                  Const swDwgPaperAsizeVertical = 1

                  Const swDwgPaperBsize = 2

                  'Const swDwgPaperCsize = 3

                  'Const swDwgPaperDsize = 4

               

               

                 

                  If (Round(SheetWidth, 4) = 0.2794) And (Round(SheetHeight, 4) = 0.2159) Then

                      GetSheetSizeFromPaperSize = swDwgPaperAsize

                  ElseIf (Round(SheetWidth, 4) = 0.2159) And (Round(SheetHeight, 4) = 0.2794) Then

                      GetSheetSizeFromPaperSize = swDwgPaperAsizeVertical

                  ElseIf (Round(SheetWidth, 4) = 0.4318) And (Round(SheetHeight, 4) = 0.2794) Then

                      GetSheetSizeFromPaperSize = swDwgPaperBsize

                  ElseIf (Round(SheetWidth, 4) = 0.6096) And (Round(SheetHeight, 4) = 0.4572) Then 'C size

                      GetSheetSizeFromPaperSize = swDwgPaperBsize

                  ElseIf (Round(SheetWidth, 4) = 0.9144) And (Round(SheetHeight, 4) = 0.6096) Then 'D size

                      GetSheetSizeFromPaperSize = swDwgPaperBsize

                     

                  End If

               

               

              End Function

               

            • Re: Macro will not run from shortcut on toolbar
              Dan Pihlaja

              Are you sure that the method that you have selected is correct?