3 Replies Latest reply on Sep 13, 2013 2:17 AM by Victor B

    Macro building features in a loop doesn’t work

    Victor B

      Hello all


      I write a macro that takes coordinates of two ends of a cylinder and draw it by Sweep. The coordinates and the radius are in a text file. With the help of macro recording I found how to build it for one cylinder. Now I do this in a loop and get the following wonders:

      The first four cylinders are built normally.

      The fifth 3D sketch is drawn, but the extrusion not.

      The sixth 3D sketch is not drawn.

      If I try this several times, the Solid crashes.

      I am new in macroing for the Solid. What do I do wrong?

      Thank you


      Sub main()

      Dim n As Integer


      Set swApp = Application.SldWorks


      Set Part = swApp.NewDocument("C:\Documents and Settings\All Users\Application Data\SolidWorks\SolidWorks 2010\templates\Part.prtdot", 0, 0, 0)

      swApp.ActivateDoc2 "Part1", False, longstatus


      Set Part = swApp.ActiveDoc


      'file reading

      Set objFSO = CreateObject("Scripting.FileSystemObject")

      Set objFile = objFSO.OpenTextFile("D:\My\OptimalDesign\Dropbox\TreeBot\MeasureArm\TreeRe\Apple11_10_13\Tree2.txt", 1)

      Dim s As String

      Dim a() As String

      Dim x, dx, y, dy, z, dz, r As Double



      s = objFile.ReadLine

      n = CInt(s)


      For i = 1 To n

          s = objFile.ReadLine

          a = Split(s, "   ", -1, 1)

          x = CDbl(a(0))

          y = CDbl(a(1))

          z = CDbl(a(2))

          dx = CDbl(a(3))

          dy = CDbl(a(4))

          dz = CDbl(a(5))

          r = CDbl(a(6))



          Part.SketchManager.Insert3DSketch True

          Dim skSegment As Object

          Set skSegment = Part.SketchManager.CreateLine(x, y, z, x + dx, y + dy, z + dz)

          Part.SketchManager.Insert3DSketch False

          Part.ClearSelection2 True


          boolstatus = Part.Extension.SelectByID2("Line1@3DSketch" & CStr(i), "EXTSKETCHSEGMENT", x, y, z, True, 0, Nothing, 0)

          boolstatus = Part.Extension.SelectByID2("Point1@3DSketch" & CStr(i), "EXTSKETCHPOINT", x, y, z, True, 1, Nothing, 0)

          Dim myRefPlane As Object

          Set myRefPlane = Part.FeatureManager.InsertRefPlane(2, 0, 4, 0, 0, 0)


          boolstatus = Part.Extension.SelectByID2("Plane" & CStr(i), "PLANE", x, y, z, False, 0, Nothing, 0)

          Part.SketchManager.InsertSketch True

          Set skSegment = Part.SketchManager.CreateCircleByRadius(0, 0, 0#, r)


          boolstatus = Part.Extension.SelectByID2("Sketch" & CStr(i), "SKETCH", x, y, 0#, False, 1, Nothing, 0)

          boolstatus = Part.Extension.SelectByID2("3DSketch" & CStr(i), "SKETCH", x, y, z, True, 4, Nothing, 0)

          Dim myFeature As Object

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

          'Hide plane

          boolstatus = Part.Extension.SelectByID2("Plane" & CStr(i), "PLANE", x, y, z, False, 0, Nothing, 0)


          'Unhide line

          boolstatus = Part.Extension.SelectByID2("3DSketch" & CStr(i), "SKETCH", x, y, z, False, 0, Nothing, 0)





      End Sub