Help with Circular pattern feature VBA

[nilsgam]

Hey,

I want to programm a macro with vba which automatically creates a flange. 

I need to create a given amount of holes (4, 8, 16, 20) around the middle axis of the flange and I want to use the CircularPatternFeature command.

My current code:

    Dim objCol As ObjectCollection
    Set objCol = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oDoc.ComponentDefinition

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

    Dim Mp As Point2d           'Mittelpunkt
    Set Mp = oTG.CreatePoint2d(0, 0)

    Dim Ak As SketchCircle      'Aussenkreis
    Set Ak = oSketch.SketchCircles.AddByCenterRadius(Mp, Dm / 2)

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

    Dim oExtrudeDef1 As ExtrudeDefinition
    Set oExtrudeDef1 = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile1, kNewBodyOperation)

    Call oExtrudeDef1.SetDistanceExtent(th, kPositiveExtentDirection)

    Dim oExtrude1 As ExtrudeFeature
    Set oExtrude1 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef1)
    
    Dim MpL As Point2d          'Mittelpunkt Loch
    Set MpL = oTG.CreatePoint2d(LkDm / 2, 0)
    
    Dim KL As SketchCircle      'Kreis Loch
    Set KL = oSketch.SketchCircles.AddByCenterRadius(MpL, LDm / 2)
    
    Dim oProfile2 As Profile
    Set oProfile2 = oSketch.Profiles.AddForSolid

    Dim oExtrudeDef2 As ExtrudeDefinition
    Set oExtrudeDef2 = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile2, kIntersectOperation)

    Call oExtrudeDef2.SetDistanceExtent(th, kPositiveExtentDirection)

    Dim oExtrude2 As ExtrudeFeature
    Set oExtrude2 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef2)
    
    objCol.Add (oExtrude2)
    
    Dim oCircPatternDef As CircularPatternFeatureDefinition
    Set oCircPatternDef = oCompDef.Features.CircularPatternFeatures.CreateDefinition(objCol, oCompDef.WorkAxes.Item(3), False, AL, 360 * pi / 180, True)
    
    Dim oCircPattern As CircularPatternFeature
    Set oCircPattern = oCompDef.Features.CircularPatternFeatures.AddByDefinition(oCircPatternDef)

 When I run this I get the error message 438 "object doesn't support this property or method".

And it highlights the line: objCol.Add (oExtrude2).

The expected variable (oExtrude2) has to be an object but it is a ExtrudeFeature and I don't know how to fix it.

I saw somebody on another forum made it work like this. 

Any ideas?

[Ralf_Krieg · Accepted solution]

Hello

Can't explain why, but seems to be related to the intersect extrusion.

Try this one

Dim objCol As ObjectCollection
    Set objCol = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oDoc.ComponentDefinition

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

    Dim Mp As Point2d           'Mittelpunkt
    Set Mp = oTG.CreatePoint2d(0, 0)

    Dim Ak As SketchCircle      'Aussenkreis
    Set Ak = oSketch.SketchCircles.AddByCenterRadius(Mp, Dm / 2)
    
    Call objCol.Add(Ak)
    
    Dim oProfile1 As Profile
    Set oProfile1 = oSketch.Profiles.AddForSolid(True, objCol)

    Dim oExtrudeDef1 As ExtrudeDefinition
    Set oExtrudeDef1 = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile1, kNewBodyOperation)

    Call oExtrudeDef1.SetDistanceExtent(th, kPositiveExtentDirection)

    Dim oExtrude1 As ExtrudeFeature
    Set oExtrude1 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef1)

    Dim MpL As Point2d          'Mittelpunkt Loch
    Set MpL = oTG.CreatePoint2d(LkDm / 2, 0)
 
    Dim KL As SketchCircle      'Kreis Loch
    Set KL = oSketch.SketchCircles.AddByCenterRadius(MpL, LDm / 2)
    
    objCol.Clear
    Call objCol.Add(KL)
    
    Dim oProfile2 As Profile
    Set oProfile2 = oSketch.Profiles.AddForSolid(False, objCol)

    Dim oExtrudeDef2 As ExtrudeDefinition
    Set oExtrudeDef2 = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile2, kCutOperation)

    Call oExtrudeDef2.SetDistanceExtent(th, kPositiveExtentDirection)

    Dim oExtrude2 As ExtrudeFeature
    Set oExtrude2 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef2)
    
    objCol.Clear
    Call objCol.Add(oExtrude2)
    
   
    Dim oCircPatternDef As CircularPatternFeatureDefinition
    Set oCircPatternDef = oCompDef.Features.CircularPatternFeatures.CreateDefinition(objCol, oCompDef.WorkAxes.Item(3), False, AL, 360 * Pi / 180, True)
    
    Dim oCircPattern As CircularPatternFeature
    Set oCircPattern = oCompDef.Features.CircularPatternFeatures.AddByDefinition(oCircPatternDef)

[nilsgam]

Thank you this works 🙂