3 Replies Latest reply on Aug 24, 2015 11:22 AM by Ruchit Solanki

    Macro in assembly to insert a part

    Ruchit Solanki

      Following macro is recorded in Solidworks 2013. It is supposed to opens up a assembly document and then opens a part document and create a disk of some radius and then add that part (disk) into a assembly.

       

      Problem with this macro is that when macro is run, it opens a part document create a disk then after shows error "RUN TIME ERROR 438- OBJECT DOESNOT SUPPORT THIS PROPERTY OR METHOD".  when macro is checked it shows error while adding part into assembly. Please go through this macro and let me know what could the problem and possible solution for it

       

      Macro is as under.

       

       

       

       

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

      ' C:\Users\welcome\AppData\Local\Temp\swx5792\Macro1.swb - macro recorded on 08/23/15 by welcome

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

      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.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2013\templates\Assembly.asmdot", 0, 0, 0)

      swApp.ActivateDoc2 "Assem1", False, longstatus

      Set Part = swApp.ActiveDoc

      Dim myModelView As Object

      Set myModelView = Part.ActiveView

      myModelView.FrameState = swWindowState_e.swWindowMaximized

      Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2013\templates\Part.prtdot", 0, 0, 0)

      swApp.ActivateDoc2 "Part2", False, longstatus

      Set Part = swApp.ActiveDoc

      Set myModelView = Part.ActiveView

      myModelView.FrameState = swWindowState_e.swWindowMaximized

      Part.SketchManager.InsertSketch True

      boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", -7.21379555082772E-02, 0.052300249193058, 2.53419852237989E-03, False, 0, Nothing, 0)

      Part.ClearSelection2 True

      Dim skSegment As Object

      Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.027286, -0.061243, 0#)

      Part.ShowNamedView2 "*Trimetric", 8

      Part.ClearSelection2 True

      boolstatus = Part.Extension.SelectByID2("Arc1", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)

      Dim myFeature As Object

      Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.01, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)

      Part.SelectionManager.EnableContourSelection = False

      Part.ClearSelection2 True

      Part.ShowNamedView2 "*Isometric", 7

      Part.ShowNamedView2 "*Isometric", 7

      longstatus = Part.SaveAs3("C:\Users\welcome\Desktop\SW\New folder\Part10.SLDPRT", 0, 2)

      Set Part = Nothing

      swApp.CloseDoc "Part10.SLDPRT"

      Set Part = swApp.ActiveDoc

      Set myModelView = Part.ActiveView

      myModelView.FrameLeft = 0

      myModelView.FrameTop = 0

      Set myModelView = Part.ActiveView

      myModelView.FrameState = swWindowState_e.swWindowMaximized

      swApp.ActivateDoc2 "Assem1", False, longstatus

      Set Part = swApp.ActiveDoc

      Set myModelView = Part.ActiveView

      myModelView.FrameState = swWindowState_e.swWindowMaximized

      boolstatus = Part.AddComponent("C:\Users\welcome\Desktop\SW\New folder\Part9.SLDPRT", 5.34727383916481E-02, 5.19025854256837E-02, 9.43109047020583E-02)

      Part.ShowNamedView2 "*Isometric", 7

      Part.ShowNamedView2 "*Isometric", 7

      longstatus = Part.SaveAs3("C:\Users\welcome\Desktop\SW\New folder\Assem1.SLDASM", 0, 2)

      End Sub

        • Re: Macro in assembly to insert a part
          Deepak Gupta

          You are saving part as part 10 but inserting part 9 into assy which might not be present.

           

          Also clean up the codes and remove unwanted stuff.

          • Re: Macro in assembly to insert a part
            Deepak Gupta

            Here is quick cleaned (would need more clean up) working code. change paths and file names as required.

             

            Dim swApp As Object

            Dim Part As Object

            Dim Assy As Object

            Dim boolstatus As Boolean

            Dim myFeature As Object

            Dim skSegment As Object

            Dim lErrors             As Long

            Dim lWarnings           As Long

            Dim longstatus As Long, longwarnings As Long

            Sub main()

             

             

            Set swApp = Application.SldWorks

             

            Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2014\templates\Part.prtdot", 0, 0, 0)

            Set Part = swApp.ActiveDoc

             

            Part.SketchManager.InsertSketch True

            boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", -7.21379555082772E-02, 0.052300249193058, 2.53419852237989E-03, False, 0, Nothing, 0)

            Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.027286, -0.061243, 0#)

            Part.ClearSelection2 True

            boolstatus = Part.Extension.SelectByID2("Arc1", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)

            Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.01, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)

            Part.Extension.SaveAs "C:\Users\DEEPAK\Desktop\Test SW\Part10.SLDPRT", 0, 1, Nothing, lErrors, lWarnings

             

            Set Assy = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2014\templates\Assembly.asmdot", 0, 0, 0)

            Set Assy = swApp.ActiveDoc

            boolstatus = Assy.AddComponent("Part10.SLDPRT", 5.34727383916481E-02, 5.19025854256837E-02, 9.43109047020583E-02)

            Assy.ShowNamedView2 "*Isometric", 7

            Assy.Extension.SaveAs "C:\Users\DEEPAK\Desktop\Test SW\Assem1.SLDASM", 0, 1, Nothing, lErrors, lWarnings

             

            End Sub