1 Reply Latest reply on Aug 21, 2017 5:53 PM by Nilesh Patel

    Create Sweep from Sketch Macro

    John Maldonado

      Hello,

       

      I'm pretty new to the macro world, but I was trying to make a macro to create a circular profile sweep with a 0.25"OD from a newly inserted (or currently selected) 3D sketch.

      I do this very often so saving the few clicks and key strokes it takes would be amazing. I recorded the steps I take with the macro recorder. The problem I run into is that it only works with the first inserted sketch. Below is my code. I'm pretty sure why it's doing it. But I don't know how to change it to accept any 3d sketch. Any help is appreciated. Thank you.

       

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

      ' C:\Users\xxxxxxx\AppData\Local\Temp\swx9300\Macro1.swb - macro recorded on 08/21/17 by xxxxxxxxxx

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

      Dim swApp As Object

       

       

      Dim Part As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

       

       

      Sub main()

       

       

      Set swApp = Application.SldWorks

       

       

      Set Part = swApp.ActiveDoc

      Part.SketchManager.InsertSketch True

      Part.ClearSelection2 True

      boolstatus = Part.Extension.SelectByID2("3DSketch1", "SKETCH", 0, 0, 0, False, 4, Nothing, 0)

      Dim myFeature As Feature

      Set myFeature = Part.FeatureManager.InsertProtrusionSwept4(False, False, 0, False, False, 0, 0, False, 0, 0, 0, 0, True, True, True, 0, True, True, 0.00635, False)

       

       

      End Sub

        • Re: Create Sweep from Sketch Macro
          Nilesh Patel

          Hi John,

           

          Try following codes:

           

          Option Explicit
          
          
          Sub main()
          
          
              Dim swApp       As SldWorks.SldWorks
              Dim swModel     As ModelDoc2
              Dim swFeat      As Feature
              Dim swSketch    As Sketch
              
              Set swApp = Application.SldWorks
              Set swModel = swApp.ActiveDoc
              Set swFeat = swModel.FirstFeature
              
              While Not swFeat Is Nothing
                  If swFeat.GetTypeName = "3DProfileFeature" Then
                      Set swSketch = swFeat.GetSpecificFeature2
                      If swSketch.Is3D Then
                          swModel.Extension.SelectByID2 swFeat.Name, "SKETCH", 0, 0, 0, False, 0, Nothing, 0
                          'Insert sweep feature here.
                      End If
                  End If
                  Set swFeat = swFeat.GetNextFeature
              Wend
          End Sub