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

'Branches

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))

    'line

    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

    'plane

    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)

    'circle

    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)

    'Sweep

    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)

    Part.BlankRefGeom

    'Unhide line

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

    Part.UnblankSketch

Next

Part.ViewZoomtofit2

End Sub