Как программно выбрать плоскость?

[slvranis 0]

Плоскость 1 определяется через точку с координатами xpoint, yabs на плоскости справа параллельно плоскости спереди.

На этой плоскости требуется разместить новый эскиз- линию и окружность.

Все это процедура которая вызывается в цикле. То есть имеется 4 набора xpoint, yabs. То есть должно быть 4 плоскости

и на них размещены 4 эскиза. Но по этому коду создается только 1 плоскость и на ней размещаются все 4 эскиза.

boolstatus = Part.Extension.SelectByID2(Справа", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

Part.SketchManager.InsertSketch True

Dim skPoint As Object

Set skPoint = Part.SketchManager.CreatePoint(xpoint, yabs, 0#)

Part.ClearSelection2 True



boolstatus = Part.Extension.SelectByID2("Point1@Эскиз2", "EXTSKETCHPOINT", xpoint, yabs, 0, True, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Спереди", "PLANE", 0, 0, 0, True, 0, Nothing, 0)



Dim myRefPlane As Object

Set myRefPlane = Part.CreatePlaneThruPtParallelToPlane(True)

Part.ClearSelection2 True



boolstatus = Part.Extension.SelectByID2("Плоскость1", "PLANE", 0, 0, 0, False, 0, Nothing, 0)



Part.SketchManager.InsertSketch True

Part.SetPickMode



Dim skSegment As Object

Set skSegment = Part.SketchManager.CreateCenterLine(0#, yabs, 0#, xabs, yabs, 0#)

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

Part.ClearSelection2 True

<noindex> </noindex>

Как сделать чтобы для каждого набора координат точки создавались свои плоскости, проходящие через эту точку??

[ssv22 17]

'slvranis' date='Feb 13 2011, 15:36' post='380201']

Несколько неясно:

- что такое "xabs" и "yabs"? (переменные?)?

- откуда приведенный код взялся?

- версия SW? язык?

- желательно описать задачу подробнее(цель?): "известно, что одна (и даже две!) точки никак не могут определить "уникальную" единственнную плоскость..."

[slvranis 0]

Несколько неясно:

- что такое "xabs" и "yabs"? (переменные?)?

- откуда приведенный код взялся?

- версия SW? язык?

- желательно описать задачу подробнее(цель?): "известно, что одна (и даже две!) точки никак не могут определить "уникальную" единственнную плоскость..."

Переменные, я их выше задаю. Их 4 пары. В них проблемы нет..четко даются 4 пары при каждом обращение к этой процедуре.

Ну это собственно отредактированный макрос

Dim swApp As Object



Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Dim diam As Double

Dim leng As Single

Dim th As Single

Dim xabs As Single

Dim yabs As Single

Dim diamobj As Single

Dim posmid As Integer

Dim objtxt As String

Dim element As Variant

Dim filenum As Integer

Dim Typ As Integer

Dim Rad As Boolean

Dim xpoint As Double







Sub main()





filenum = FreeFile

Open "d:\pss.txt" For Input As filenum

Do Until EOF(filenum)

Line Input #filenum, txt

alltxt = alltxt + txt

Loop

Close #filenum



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

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

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

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

objtxt = Mid(alltxt, posmid + 18)









Set swApp = Application.SldWorks



Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2009\templates\Деталь.prtdot", 0, 0, 0)

swApp.ActivateDoc2 "Деталь92", 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

Part.ClearSelection2 True







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

Dim mas() As String

mas() = Split(element)

ReDim Preserve mas(11)

Typ = Val(mas(2))

xabs = Val(mas(5)) / 1000

diamobj = Val(mas(10)) / 1000

W = Val(mas(11))

Rad = mas(6) Like "false"



If Rad = True Then

yabs = Val(mas(9)) / 1000

xpoint = -Sqr(0.25 * diam ^ 2 - yabs ^ 2)

Else

If Rad = False Then

Dim grad As Double

grad = Val(mas(9))

yabs = 0.5 * diam * Math.Sin(grad)

xpoint = -0.5 * diam * Abs(Math.Cos(grad))

End If

End If

Call prrroc



Next





End Sub



































Public Sub prrroc()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

Dim myModelView As Object

boolstatus = Part.Extension.SelectByID2("Справа", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

Part.SketchManager.InsertSketch True

Dim skPoint As Object

Set skPoint = Part.SketchManager.CreatePoint(xpoint, yabs, 0#)

Part.ClearSelection2 True

Part.SketchManager.InsertSketch True

boolstatus = Part.Extension.SelectByID2("Point1@Эскиз2", "EXTSKETCHPOINT", xpoint, yabs, 0, True, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Спереди", "PLANE", 0, 0, 0, True, 0, Nothing, 0)

Dim myRefPlane As Object

Set myRefPlane = Part.CreatePlaneThruPtParallelToPlane(True)

boolstatus = Part.Extension.SelectByID2("Плоскость1", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Эскиз2", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Плоскость1", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

Part.SketchManager.InsertSketch True

Part.ClearSelection2 True

Part.SetPickMode

Part.SetPickMode

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Плоскость1", "PLANE", 0, 0, 0, True, 0, Nothing, 0)

Part.SketchManager.InsertSketch True

Set skSegment = Part.SketchManager.CreateCenterLine(0#, yabs, 0#, xabs, yabs, 0#)

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

Part.ClearSelection2 True

Part.SketchManager.InsertSketch True

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Эскиз3", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

Set myFeature = Part.FeatureManager.FeatureCut(False, False, False, 5, 1, 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

Solidworks 2009 sp0:) vba:)

хотелось бы вот такое на поверхности одного цилиндра 4 раза видеть в разных позициях

<noindex> </noindex>

xpoint,yabs задают позицию точки на поверхности справа. xabs расстояние вдоль цилиндра.

Плоскость проходит через точку (xpoint,yabs) параллельно поверхности спереди. На этой плоскости создается эскиз, От точки (xpoint,yabs) горизонтально на расстоянии xabs создается окружность, которая вырезается из цилиндра!