13 Replies Latest reply on Nov 21, 2018 3:45 PM by Mike Flanders

    ADDING TWO MACROS TOGETHER

    Mike Flanders

      Anybody want to way in on getting these two macros to run together?

       

      I'm trying to get this grind print macro to run then go into the red figure macro. I would like my print to copy then past itself as a new sheet, rename itself to what I specify in the macro, which will be RED FIGURE probably but I can change that from inside the macro itself. I then want it to take the active sheet and run the red figure conversion macro. I have been inside of both of these and have been cutting & pasting stuff to try to get it to work but I'm having no luck.

        • Re: ADDING TWO MACROS TOGETHER
          Gertjan Van Dijk

          The universally accepted way is to make an "umbrella" macro; let's name it "DoBoth".

           

          Macro "DoBoth"

           

          sub main

           

          GrindPrint

          RedfigureAll

           

          end sub

           

           

          That will do what you want it to do, while still allowing you to use either of the existing macros on their own, should you want to.

            • Re: ADDING TWO MACROS TOGETHER
              Mike Flanders

              guess I don't follow how that is going to run through a sequence of running the Grind Print macro then running the redfigurealldims2ways macro. Is it that simple to just write it as you have it?

                • Re: ADDING TWO MACROS TOGETHER
                  Gertjan Van Dijk

                  If they are written one after the other, in the same file, yes

                   

                   

                  What the macro "DoBoth" contains is, when written as if i were telling a person the same thing, would be something like: "First do 'GrindPrint', and when you are done with that, also do 'RedfigureAll'"

                   

                   

                   

                  This is one small macro we use in our company:

                  Update starts with:

                   

                  Sub Update()

                       Set swApp = Application.SldWorks

                       Set swModel = swApp.ActiveDoc

                   

                       Call Load(LoadSmarteam, Smarteam)

                       {more stuff}

                  End Sub

                   

                  Sub Load(LoadSmarteam, Smarteam)

                       {some code}

                  End Sub

                   

                   

                  That ensures that whatever i want to update is actually loaded; if i were to place the "Load" code inside of "Update", i would not be able to load without also updating

              • Re: ADDING TWO MACROS TOGETHER
                Jerome De San Nicolás

                Hi,

                If you need to run the 2 macros one then the other, you can try the RunMacro2 Method :

                2017 SOLIDWORKS API Help - RunMacro2 Method (ISldWorks)

                • Re: ADDING TWO MACROS TOGETHER
                  John Christensen

                  Try this:

                  RunMacro will call other saved macros.

                  Work with the filename to determine correct file path from where RunMacro resides, and that of other standalone macros.

                   

                   

                  ' RunMacro.swp

                  '

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

                  Option Explicit
                  Dim swApp As SldWorks.SldWorks
                  Dim boolstatus As Boolean

                  Sub main()
                  Set swApp = Application.SldWorks
                  Dim filename As String
                  filename = swApp.GetCurrentMacroPathName

                   

                  'file path, add \ character, macro to call
                  filename = Left(filename, InStrRev(filename, "\")) + "GrindPrint.swp"

                  'can call subs within macros too

                  'file path, module name, sub name, call the program
                  boolstatus = swApp.RunMacro(filename, "Grind_sub", "main")

                   

                  'file path, add \ character, macro to call

                  filename = Left(filename, InStrRev(filename, "\")) + "RedfigureAll.swp"

                  'can call subs within macros too

                  'file path, module name, sub name, call the program
                  boolstatus = swApp.RunMacro(filename, "Redfigure_sub", "main")


                  End Sub

                  • Re: ADDING TWO MACROS TOGETHER
                    Roland Schwarz

                    I’ve had bad luck with “RunMacro”. Macros don’t always run right when called that way.

                     

                    i would just make a new macro and copy-paste the code from the two others.

                      • Re: ADDING TWO MACROS TOGETHER
                        Mike Flanders

                        That is what I was hoping to do. I posted both macros. I don't know what is causing it not to do anything.

                          • Re: ADDING TWO MACROS TOGETHER
                            Fifi Riri

                            Option Explicit

                            Dim swApp As SldWorks.SldWorks

                            Dim swDoc As SldWorks.ModelDoc2

                            Dim swDwg As SldWorks.DrawingDoc

                            Dim swView As SldWorks.View

                            Dim swDispDim As SldWorks.DisplayDimension

                            Dim swDim As SldWorks.Dimension

                            Dim vDimVal As Variant

                            Dim dInchVal As Double

                            Dim sNewSuffix As String

                            Const ShrinkH As Double = 0.812

                            Const ShrinkV As Double = 0.809

                            Dim myShrinkH As Double

                            Dim myShrinkV As Double

                            Dim DisplayData As SldWorks.DisplayData

                            Dim ArrowHeadPos As Variant

                            Dim ArrowHeadDir As Variant

                            Dim length As Double

                            Dim boolstatus As Boolean

                             

                            Sub main()

                            Set swApp = Application.SldWorks

                            Set swDoc = swApp.ActiveDoc

                            If swDoc.GetType <> swDocDRAWING Then

                                MsgBox "This macro only works for drawing files."

                                Exit Sub

                            End If

                            Set swDwg = swDoc

                             

                            Dim myModelView As Object

                            Set myModelView = swDwg.ActiveView

                            myModelView.FrameState = swWindowState_e.swWindowMaximized

                            boolstatus = swDwg.Extension.SelectByID2("PREFORM", "SHEET", 0, 0, 0, False, 0, Nothing, 0)

                            swDwg.EditCopy

                            swDwg.Paste

                             

                            ' Zoom To Fit

                            swDwg.ViewZoomtofit2

                            swDwg.ClearSelection2 True

                            Dim myDrawingSheet As Object

                            Set myDrawingSheet = swDwg.GetCurrentSheet()

                            myDrawingSheet.SetName "GRIND PRINT"

                            boolstatus = swDwg.ActivateView("Drawing View6")

                            boolstatus = swDwg.Extension.SelectByRay(0.119488618854222, 0.129761048681381, 166.666666666667, 0, 0, -1, 5.89599615358807E-04, 46, False, 0, 0)

                            Dim mySFSymbol As Object

                            Set mySFSymbol = swDwg.Extension.InsertSurfaceFinishSymbol3(1, 0, 0.119488618854222, 0.13016976693026, 0, 0, 1, "", "", "", "", "", "", "")

                            Dim myAnnotation As Object

                            Set myAnnotation = mySFSymbol.GetAnnotation()

                            boolstatus = swDwg.Extension.SelectByRay(7.12888502986395E-02, 0.129024049162183, 166.666666666667, 0, 0, -1, 5.89599615358807E-04, 46, False, 0, 0)

                            Set mySFSymbol = swDwg.Extension.InsertSurfaceFinishSymbol3(1, 0, 7.13771878231216E-02, 0.128935711637701, 0, 0, 1, "", "", "", "", "", "", "")

                            Set myAnnotation = mySFSymbol.GetAnnotation()

                            boolstatus = swDwg.Extension.SelectByRay(7.01096510679219E-02, 0.126960450508427, 166.66931431713, 0, 0, -1, 5.89599615358807E-04, 1, False, 0, 0)

                            Set mySFSymbol = swDwg.Extension.InsertSurfaceFinishSymbol3(1, 0, 7.05397430676813E-02, 0.126960450508427, 0, 0, 1, "", "", "", "", "", "", "")

                            Set myAnnotation = mySFSymbol.GetAnnotation()

                            boolstatus = swDwg.ActivateSheet("GRIND PRINT")

                            'Rebuild

                            swDwg.ForceRebuild3 (True)

                             

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

                            myShrinkH = Val(InputBox("Enter the Horizontal Shrink Value:", "SHRINK VALUE", ShrinkH))

                            If myShrinkH = 0 Then Exit Sub

                            myShrinkV = Val(InputBox("Enter the Vertical Shrink Value:", "SHRINK VALUE", ShrinkV))

                            If myShrinkV = 0 Then Exit Sub

                             

                            Set swView = swDwg.GetFirstView

                            While Not (swView Is Nothing)

                                Set swDispDim = swView.GetFirstDisplayDimension5

                                While Not swDispDim Is Nothing

                                    Set DisplayData = swDispDim.GetDisplayData

                                    ArrowHeadPos = DisplayData.GetArrowHeadAtIndex2(0)

                                    ArrowHeadDir = DisplayData.GetArrowHeadAtIndex2(1)

                                    Set swDim = swDispDim.GetDimension

                                    vDimVal = swDim.GetValue3(swThisConfiguration, Empty)

                                   

                                    boolstatus = swDim.GetSystemChamferValues(length, Empty)

                                   

                                    If (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingLinearDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                        'precision <2

                                        GoTo nextdim

                                    ElseIf boolstatus Then

                                        'chamfer

                                        dInchVal = length / 0.00254 / myShrinkH

                                    ElseIf swView.GetDimensionCount4 < 8 Then

                                        'side view

                                        dInchVal = vDimVal(0) / myShrinkH

                                    ElseIf DisplayData.GetArrowHeadCount <> 2 Then

                                        'Radius

                                        dInchVal = vDimVal(0) / myShrinkH

                                    ElseIf Abs(ArrowHeadPos(0) - ArrowHeadDir(0)) < 0.0001 Then

                                        'vertical dim

                                        dInchVal = vDimVal(0) / myShrinkV

                                    ElseIf Abs(ArrowHeadPos(1) - ArrowHeadDir(1)) < 0.0001 Then

                                        'horizontal dim

                                         dInchVal = vDimVal(0) / myShrinkH

                                    Else

                                        'other dim

                                        GoTo nextdim

                                    End If

                                    

                                    sNewSuffix = vbCr & "<FONT color=0x000000ff>(" & FormatNumber(dInchVal, 3) & ")<FONT color=0x000000ff>"

                                    swDispDim.SetText swDimensionTextSuffix, sNewSuffix

                            nextdim:

                                    Set swDispDim = swDispDim.GetNext5

                                Wend

                                Set swView = swView.GetNextView

                            Wend

                            End Sub