Sub MovePoint()
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
Dim oPoint As SketchPoint3DProxy
Dim nPoint As Point
Set oPoint = ThisApplication.ActiveDocument.SelectSet.Item(1)
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
Set nPoint = oTG.CreatePoint(10, 10, 10)
Call oPoint.MoveTo(nPoint)
End Sub
Макрос проходитбез ошибок, но чтоостается на месте... Может я не тот метод использую?
Sub MoveSketchPoint3D_Corrected()
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
Dim oAsmDoc As AssemblyDocument
Set oAsmDoc = ThisApplication.ActiveDocument
' ссылка на эскизную точку в 3D-эскизе
Dim oSketchPoint3DProxy As SketchPoint3DProxy
Set oSketchPoint3DProxy = ThisApplication.ActiveDocument.SelectSet.Item(1)
' создание координатной точки (куда хотим попасть)
Dim oPoint As Point
Set oPoint = oTG.CreatePoint(10, 10, 10)
' перемещение выделенного объекта oSketchPoint3DProxy
Call oSketchPoint3DProxy.MoveTo(oPoint)
Beep
End Sub
Sub WorkPoint_By_SketchPoint3D()
'selected point
Dim oSketchPoint3DProxy As SketchPoint3DProxy
Set oSketchPoint3DProxy = ThisApplication.ActiveDocument.SelectSet.Item(1)
' Get the Harness assembly
Dim oCHAssy As AssemblyDocument
Set oCHAssy = ThisApplication.ActiveEditDocument
' Get the Harness part
Dim oCHPart As PartDocument
Set oCHPart = oCHAssy.ComponentDefinition.Occurrences(1).Definition.Document
Dim wp As WorkPoint
For Each wp In oCHPart.ComponentDefinition.WorkPoints
If wp.Point.IsEqualTo(oSketchPoint3DProxy.Geometry) Then
Beep
MsgBox ("Found !!!")
End If
Next
MsgBox "Done"
End Sub
Почему эта команда не хочет работать с некоторыми точками в сборке? После выполнения кода перед этой строкой в переменной oNewPt находятся новые координаты точки, но после выполнения команды точка oWkPt остается на прежнем месте и не перемещается в заданные координаты!?Код - Visual Basic [Выбрать]
'redefine workpoint position Call oWkPt.SetFixed(oNewPt)