Построение в цикле

[slvranis 0]

Считывая данные из текстового файла солид по макросу должен сделать несколько отверстий на цилиндрической поверхности. В файле имеются данные для построения 4 отверстий. Сама поверхность строится ниже, вырезы производятся вызовом процедуры secproc в цикле For each next.

Private Sub CommandButton1_Click()

diam = Val(Split(alltxt, "#Diameter")(1)) / 1000

leng = Val(Split(alltxt, "#Length")(1)) / 1000

th = Val(Split(alltxt, "#Thickness")(1)) / 1000





Set swApp = Application.SldWorks



Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2009\templates\Äåòàëü.prtdot", 0, 0, 0)

swApp.ActivateDoc2 "Äåòàëü17", False, longstatus

Set Part = swApp.ActiveDoc

Dim myModelView As Object

Set myModelView = Part.ActiveView

myModelView.FrameState = swWindowState_e.swWindowMaximized

boolstatus = Part.Extension.SelectByID2("Ñïðàâà", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

Part.SketchManager.InsertSketch True

Part.ClearSelection2 True

Dim skSegment As Object

Set skSegment = Part.SketchManager.CreateCircle(-0#, 0#, 0#, 0#, diam / 2, 0#)

Part.ClearSelection2 True

Set skSegment = Part.SketchManager.CreateCircle(-0#, 0#, 0#, 0#, diam / 2 - th, 0#)

Part.ClearSelection2 True

Part.SketchManager.InsertSketch True

Part.ShowNamedView2 "*Òðèìåòðèÿ", 8

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Ýñêèç1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

Dim myFeature As Object

Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, leng, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, True, True, True, 0, 0, False)

Part.SelectionManager.EnableContourSelection = False



posmid = InStr(1, alltxt, "#ObjectDefinitions")

objtxt = Mid(alltxt, posmid + 18)



For Each element In Split(objtxt, "#")

Dim mas() As String

mas() = Split(element)

ReDim Preserve mas(12)

Typ = Val(mas(2))

xabs = Val(mas(5)) / 1000

yabs = Val(mas(9)) / 1000

diamobj = Val(mas(11)) / 1000

W = Val(mas(12))



Call secproc



Next

End Sub



Private Sub secproc()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

Dim myModelView As Object

Set myModelView = Part.ActiveView

myModelView.FrameState = swWindowState_e.swWindowMaximized

boolstatus = Part.Extension.SelectByID2("Ñïåðåäè", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

Part.SketchManager.InsertSketch True

Part.ClearSelection2 True

Dim skSegment As Object

Set skSegment = Part.SketchManager.CreateCircle(xabs, yabs, 0#, xabs, yabs + diamobj, 0#)

Part.ClearSelection2 True

Part.SketchManager.InsertSketch True

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Ýñêèç2", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

Dim myFeature As Object

Set myFeature = Part.FeatureManager.FeatureCut(True, False, True, 1, 0, 0.5, 0.5, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, False, True, True)

Part.SelectionManager.EnableContourSelection = False

End Sub

В общем проблема в следующем: Макрос строит сам цилиндр, но не строит все отверстия. Только последнее появляется. Что сделать?? помогите...