Help With Creating Circularpattern VBA

[r.hubregsen]

Does Anybody know how to create a circular pattern around the predefined Z axis. 

Private Sub createpattern()

Dim oCompdef As ComponentDefinition
Dim oDoc As PartDocument
Dim oSketch As PlanarSketch
Dim oPart As PartFeatures
Dim oProfile As Profile
Dim oExtrusion As ExtrudeFeature
Dim oDef As PartComponentDefinition
Dim objGeometry As TransientGeometry

Set oDoc = ThisApplication.Documents.Add(kPartDocumentObject, , True)
Set oCompdef = oDoc.ComponentDefinition
Set oSketch = oCompdef.Sketches.Add(oCompdef.WorkPlanes.Item(3))
Set objGeometry = ThisApplication.TransientGeometry

Call oSketch.SketchLines.AddAsTwoPointRectangle(objGeometry.CreatePoint2d(1, 1), objGeometry.CreatePoint2d(7, 5))

Set oProfile = oSketch.Profiles.AddForSolid
Set oExtrusion = oCompdef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, 10, kSymmetricExtentDirection, kJoinOperation)

Call oPart.CircularPatternFeatures.Add(oPart.ExtrudeFeatures.Item(1), oDef.WorkAxes.Item(3), True, 3, 360, True)

End Sub

[jonbrabbs · Accepted solution]

Hi mate,

Here you go...

Cheers

Jon

Private Sub createpattern()

Dim oDoc As PartDocument
    Set oDoc = ThisApplication.Documents.Add(kPartDocumentObject, , True)

Dim oCompdef As ComponentDefinition
    Set oCompdef = oDoc.ComponentDefinition

Dim objGeometry As TransientGeometry
    Set objGeometry = ThisApplication.TransientGeometry

Dim oSketch As PlanarSketch
    Set oSketch = oCompdef.Sketches.Add(oCompdef.WorkPlanes.Item(3))

    Call oSketch.SketchLines.AddAsTwoPointRectangle(objGeometry.CreatePoint2d(1, 1), objGeometry.CreatePoint2d(7, 5))

Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid

Dim oExtrusion As ExtrudeFeature
    Set oExtrusion = oCompdef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, 10, kSymmetricExtentDirection, kJoinOperation)

Dim objCol As ObjectCollection
    Set objCol = ThisApplication.TransientObjects.CreateObjectCollection
'Feature to be patterned
    objCol.Add oCompdef.Features(1)
    oCompdef.Features.CircularPatternFeatures.Add objCol, oCompdef.WorkAxes.Item(3), True, 3, 360, True

End Sub

[r.hubregsen]

Many thanks for the help Kind Regards Tech2Sea R. Hubregsen Tel: +31 (0)172 748046 [Beschrijving: Beschrijving: Tech2sea logo]