Sub CircularPatternFeatures()
Dim iApp As Inventor.Application
Set iApp = ThisApplication
Dim oPart As PartDocument
Set oPart = iApp.Documents.Add(DocumentTypeEnum.kPartDocumentObject, iApp.FileManager.GetTemplateFile(DocumentTypeEnum.kPartDocumentObject))
Dim oCompDef As PartComponentDefinition
Set oCompDef = oPart.ComponentDefinition
With oPart.UnitsOfMeasure
.LengthUnits = UnitsTypeEnum.kMillimeterLengthUnits
.MassUnits = UnitsTypeEnum.kKilogramMassUnits
.AngleUnits = UnitsTypeEnum.kGradAngleUnits
.TimeUnits = UnitsTypeEnum.kSecondTimeUnits
End With
Dim oSketch As PlanarSketch
Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes(3))
Dim oTransGeom As TransientGeometry
Set oTransGeom = iApp.TransientGeometry
Dim oSkPoint As SketchPoint
Set oSkPoint = oSketch.AddByProjectingEntity(oCompDef.WorkPoints(1))
Dim oSkLine1, oSkLine2 As SketchLine
Set oSkLine1 = oSketch.AddByProjectingEntity(oCompDef.WorkAxes.Item(1))
oSkLine1.Construction = False
Set oSkLine2 = oSketch.AddByProjectingEntity(oCompDef.WorkAxes.Item(2))
oSkLine2.Centerline = True
Dim oCoord1, oCoord0 As Point2d
Set oCoord0 = oTransGeom.CreatePoint2d(0, 0)
Dim oPoint0 As SketchPoint
Set oPoint0 = oSketch.SketchPoints.Add(oCoord0, True)
Set oCoord1 = oTransGeom.CreatePoint2d(0, 0)
Dim oCoord2 As Point2d
Set oCoord2 = oTransGeom.CreatePoint2d(120, 0)
Dim oLines(0 To 3) As SketchLine
Set oLines(0) = oSketch.SketchLines.AddByTwoPoints(oPoint0, oCoord2)
Call oSketch.DimensionConstraints.AddTwoPointDistance(oLines(0).StartSketchPoint, oLines(0).EndSketchPoint, DimensionOrientationEnum.kAlignedDim, oCoord2, False)
Set oCoord1 = oTransGeom.CreatePoint2d(120, 20)
Set oLines(1) = oSketch.SketchLines.AddByTwoPoints(oLines(0).EndSketchPoint, oCoord1)
Call oSketch.DimensionConstraints.AddTwoPointDistance(oLines(1).StartSketchPoint, oLines(1).EndSketchPoint, DimensionOrientationEnum.kAlignedDim, oCoord1, False)
Set oCoord1 = oTransGeom.CreatePoint2d(70, 20)
Set oCoord2 = oTransGeom.CreatePoint2d(70, 70)
Dim oArc As SketchArc
Set oArc = oSketch.SketchArcs.AddByCenterStartEndPoint(oCoord1, oLines(1).EndSketchPoint, oCoord2)
Call oSketch.DimensionConstraints.AddRadius(oArc, oCoord1, False)
Set oCoord1 = oTransGeom.CreatePoint2d(0, 70)
Set oLines(2) = oSketch.SketchLines.AddByTwoPoints(oArc.EndSketchPoint, oCoord1)
Set oLines(3) = oSketch.SketchLines.AddByTwoPoints(oLines(0).StartSketchPoint, oLines(2).EndSketchPoint)
Dim oPoint As SketchPoint
Set oPoint = oSketch.SketchPoints.Add(oCoord1, False)
Call oPoint.MoveTo(oTransGeom.CreatePoint2d(1, 71))
Call oSketch.DimensionConstraints.AddTwoPointDistance(oLines(2).StartSketchPoint, oLines(2).EndSketchPoint, DimensionOrientationEnum.kAlignedDim, oCoord1, False)
Call oSketch.GeometricConstraints.AddHorizontal(oLines(0))
Call oSketch.GeometricConstraints.AddPerpendicular(oLines(0), oLines(1))
Call oSketch.GeometricConstraints.AddTangent(oLines(1), oArc)
Call oSketch.GeometricConstraints.AddTangent(oLines(2), oArc)
Call oSketch.GeometricConstraints.AddParallel(oLines(0), oLines(2))
Call oSketch.GeometricConstraints.AddParallel(oLines(0), oSkLine1)
Call oPoint0.MoveTo(oTransGeom.CreatePoint2d(1, 1))
Dim oTextCoord As Point2d
Set oTextCoord = oTransGeom.CreatePoint2d(2, 2)
Call oSketch.DimensionConstraints.AddOffset(oSkLine2, oLines(0).StartSketchPoint, oTextCoord, True, False)
oSketch.DimensionConstraints.Item(oSketch.DimensionConstraints.Count).Parameter.Value = 35
Call oSketch.DimensionConstraints.AddOffset(oSkLine1, oLines(0).StartSketchPoint, oTextCoord, False, False)
oSketch.DimensionConstraints.Item(oSketch.DimensionConstraints.Count).Parameter.Value = 35
Dim oPr As Profile
Set oPr = oSketch.Profiles.AddForSolid
Dim PI As Double
PI = Atn(1) * 4
Dim oRevFeature, oRevFeature1 As RevolveFeature
Set oRevFeature = oCompDef.Features.RevolveFeatures.AddFull(oPr, oSkLine2, PartFeatureOperationEnum.kJoinOperation)
Set oRevFeature1 = oCompDef.Features.RevolveFeatures.AddByAngle(oPr, oSkLine2, PI / 9, PartFeatureExtentDirectionEnum.kSymmetricExtentDirection, PartFeatureOperationEnum.kCutOperation)
Dim oObCol As ObjectCollection
Set oObCol = iApp.TransientObjects.CreateObjectCollection
Call oObCol.Add(oRevFeature1)
'до этой строки все работает с той лишь разницей, что добавил Set в присвоении, и углы поменял на радианы
Dim definition As CircularPatternFeatureDefinition
Dim CPF As CircularPatternFeatures
Set CPF = oCompDef.Features.CircularPatternFeatures
Set definition = CPF.CreateDefinition(oObCol, oCompDef.WorkAxes.Item(2), False, 3, PI / 6, False)
Call CPF.AddByDefinition(definition)
'Call oCompDef.Features.CircularPatternFeatures.Add(oObCol, oCompDef.WorkAxes.Item(2), False, 3, 30, False) '- массив вокруг оси Y
''(Ошибка: System.Runtime.InteropServices.COMException : "Неопознанная ошибка (Исключение из HRESULT: 0x80004005 (E_FAIL))")
'oSketch.Visible = False
End Sub