Method Add of object 'CircularPattern'

choncua · ‎06-02-2020

Hello everyone!

Hopefully someone can help me, I try to generate a perforated plate with a certain pattern, the error is in the last operation to create a circular pattern.

Attached code and work piece.

Create two concentric circles,
an extrusion,
a new sketch with a hexagon with certain dimensions
a center mark for a hole
the hole
a rectangular pattern
here the error, when I try to create a circular pattern of the rectangular pattern.

Hopefully someone can help me.

Thank you

Public Sub SheetHole()
    Dim partdoc As PartDocument
    Set partdoc = ThisApplication.ActiveDocument
    Dim partdef As PartComponentDefinition
    Set partdef = partdoc.ComponentDefinition
    
    Dim sketch As PlanarSketch
    Set sketch = partdef.Sketches.Add(partdef.WorkPlanes.Item(2))
    sketch.Name = "Espejo"
    
    Dim oPoints As ObjectCollection
    Set oPoints = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim tg As TransientGeometry
    Set tg = ThisApplication.TransientGeometry
    
    Dim sum As Double
    Dim punto2 As SketchPoint
    Dim paso As Double
    Dim DE As Double
    Dim DI As Double
    Dim DE_Offset As Double
    Dim DI_Offset As Double
    Dim GAP As Double
    Dim point_star As Double
    Dim diahole As Double
    
    DE = 300.99
    DI = 71.12
        
    sum = (DI / 2)
    paso = 5.08
    
    point_star = paso
    
    diahole = 1.5
    
    Do While point_star < (DI / 2)
        point_star = point_star + paso
    Loop
    
    Dim cir_ext As SketchCircle
    Set cir_ext = sketch.SketchCircles.AddByCenterRadius(tg.CreatePoint2d(0, 0), (DE / 2))
    
    Dim diaDE As DiameterDimConstraint
    Set diaDE = sketch.DimensionConstraints.AddDiameter(cir_ext, tg.CreatePoint2d((DE / 2), (DE / 2)))
    
    Dim cir_int As SketchCircle
    Set cir_int = sketch.SketchCircles.AddByCenterRadius(tg.CreatePoint2d(0, 0), (DI / 2))
    
    ' Create a profile.
    Dim oProfile As Profile
    Set oProfile = sketch.Profiles.AddForSolid
    
    ' Create a base extrusion 1cm thick.
    Dim oExtrudeDef As ExtrudeDefinition
    Set oExtrudeDef = partdef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
    Call oExtrudeDef.SetDistanceExtent((1.25 * 2.54), kNegativeExtentDirection)
    Dim oExtrude As ExtrudeFeature
    Set oExtrude = partdef.Features.ExtrudeFeatures.Add(oExtrudeDef)
    oExtrude.Name = "Cuerpo Espejo"
    
    Do While point_star < (DE / 2)
        Set sketch = partdef.Sketches.Add(partdef.WorkPlanes.Item(2))
        sketch.Name = "Pattern_" & point_star
        
        Debug.Print point_star & ",0"
        Dim Pol As SketchEntitiesEnumerator
        Set Pol = sketch.SketchLines.AddAsPolygon(6, tg.CreatePoint2d(0, 0), tg.CreatePoint2d(point_star, 0), True)

        Dim oHoleFeatures As HoleFeatures
        Set oHoleFeatures = partdef.Features.HoleFeatures

        Dim oHole As HoleFeature

        Dim oHoleCenters As ObjectCollection
        Set oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection

        Set punto2 = sketch.SketchPoints.Add(tg.CreatePoint2d(point_star, 0), True)
        oHoleCenters.Add sketch.SketchPoints.Add(tg.CreatePoint2d(point_star, 0))
        
        Set oHole = partdef.Features.HoleFeatures.AddDrilledByThroughAllExtent(oHoleCenters, diahole & " in", kPositiveExtentDirection)
        
        oHole.Name = "Hole_" & point_star
        
        Dim pRectFeatures As RectangularPatternFeatures
        Set pRectFeatures = partdef.Features.RectangularPatternFeatures
        
        Dim pRect As RectangularPatternFeature
        
        Dim oFeatures As ObjectCollection
        Set oFeatures = ThisApplication.TransientObjects.CreateObjectCollection
        Call oFeatures.Add(oHole)
        
        Set pRect = partdef.Features.RectangularPatternFeatures.Add(oFeatures, partdef.WorkAxes.Item("Star_Guide_Work_Axis"), True, (point_star / paso), paso, kDefault, , partdef.WorkAxes.Item(2), False, 2, 9, kDefault, , kIdenticalCompute)
        
        pRect.Name = "HolePattern_" & point_star

        Dim pCircFeatures As CircularPatternFeatures
        Set pCircFeatures = partdef.Features.CircularPatternFeatures
        
        Dim pCirc As CircularPatternFeature

        Dim oPatternRec As ObjectCollection
        Set oPatternRec = ThisApplication.TransientObjects.CreateObjectCollection
        Call oPatternRec.Add(partdef.Features(pRect.Name))
        
        Debug.Print pRect.Name

        Set pCirc = partdef.Features.CircularPatternFeatures.Add(oPatternRec, partdef.WorkAxes.Item(2), True, 6, "360 deg", True)
        
        pCirc.Name = "Circ_Pattern_" & point_star
        
        point_star = point_star + paso
    Loop
    
End Sub

dgreatice · ‎06-02-2020

Hi,

can u provide the final result of you model?

Please use the ACCEPT AS SOLUTION or KUDOS button if my Idea helped you to solve the problem.

Autodesk Inventor Professional Certified 2014

JhoelForshav · ‎06-02-2020

Hi @choncua

CircularPatternFeatures.Add is an old method that's not documented in the API help anymore. I think it's still supported in some cases but in others it fails. The way to do it now is to create a CircularPatternFeatureDefinition and then use CircularPatternFeature.AddByDefinition.

Public Sub SheetHole()
    Dim partdoc As PartDocument
    Set partdoc = ThisApplication.ActiveDocument
    Dim partdef As PartComponentDefinition
    Set partdef = partdoc.ComponentDefinition
    
    Dim sketch As PlanarSketch
    Set sketch = partdef.Sketches.Add(partdef.WorkPlanes.Item(2))
    sketch.Name = "Espejo"
    
    Dim oPoints As ObjectCollection
    Set oPoints = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim tg As TransientGeometry
    Set tg = ThisApplication.TransientGeometry
    
    Dim sum As Double
    Dim punto2 As SketchPoint
    Dim paso As Double
    Dim DE As Double
    Dim DI As Double
    Dim DE_Offset As Double
    Dim DI_Offset As Double
    Dim GAP As Double
    Dim point_star As Double
    Dim diahole As Double
    
    DE = 300.99
    DI = 71.12
        
    sum = (DI / 2)
    paso = 5.08
    
    point_star = paso
    
    diahole = 1.5
    
    Do While point_star < (DI / 2)
        point_star = point_star + paso
    Loop
    
    Dim cir_ext As SketchCircle
    Set cir_ext = sketch.SketchCircles.AddByCenterRadius(tg.CreatePoint2d(0, 0), (DE / 2))
    
    Dim diaDE As DiameterDimConstraint
    Set diaDE = sketch.DimensionConstraints.AddDiameter(cir_ext, tg.CreatePoint2d((DE / 2), (DE / 2)))
    
    Dim cir_int As SketchCircle
    Set cir_int = sketch.SketchCircles.AddByCenterRadius(tg.CreatePoint2d(0, 0), (DI / 2))
    
    ' Create a profile.
    Dim oProfile As Profile
    Set oProfile = sketch.Profiles.AddForSolid
    
    ' Create a base extrusion 1cm thick.
    Dim oExtrudeDef As ExtrudeDefinition
    Set oExtrudeDef = partdef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
    Call oExtrudeDef.SetDistanceExtent((1.25 * 2.54), kNegativeExtentDirection)
    Dim oExtrude As ExtrudeFeature
    Set oExtrude = partdef.Features.ExtrudeFeatures.Add(oExtrudeDef)
    oExtrude.Name = "Cuerpo Espejo"
    
    Do While point_star < (DE / 2)
        Set sketch = partdef.Sketches.Add(partdef.WorkPlanes.Item(2))
        sketch.Name = "Pattern_" & point_star
        
        Debug.Print point_star & ",0"
        Dim Pol As SketchEntitiesEnumerator
        Set Pol = sketch.SketchLines.AddAsPolygon(6, tg.CreatePoint2d(0, 0), tg.CreatePoint2d(point_star, 0), True)

        Dim oHoleFeatures As HoleFeatures
        Set oHoleFeatures = partdef.Features.HoleFeatures

        Dim oHole As HoleFeature

        Dim oHoleCenters As ObjectCollection
        Set oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection

        Set punto2 = sketch.SketchPoints.Add(tg.CreatePoint2d(point_star, 0), True)
        oHoleCenters.Add sketch.SketchPoints.Add(tg.CreatePoint2d(point_star, 0))
        
        Set oHole = partdef.Features.HoleFeatures.AddDrilledByThroughAllExtent(oHoleCenters, diahole & " in", kPositiveExtentDirection)
        
        oHole.Name = "Hole_" & point_star
        
        Dim pRectFeatures As RectangularPatternFeatures
        Set pRectFeatures = partdef.Features.RectangularPatternFeatures
        
        Dim pRect As RectangularPatternFeature
        
        Dim oFeatures As ObjectCollection
        Set oFeatures = ThisApplication.TransientObjects.CreateObjectCollection
        Call oFeatures.Add(oHole)
        
        Set pRect = partdef.Features.RectangularPatternFeatures.Add(oFeatures, partdef.WorkAxes.Item("Star_Guide_Work_Axis"), True, (point_star / paso), paso, kDefault, , partdef.WorkAxes.Item(2), False, 2, 9, kDefault, , kIdenticalCompute)
        
        pRect.Name = "HolePattern_" & point_star

        Dim pCircFeatures As CircularPatternFeatures
        Set pCircFeatures = partdef.Features.CircularPatternFeatures
        
        Dim pCirc As CircularPatternFeature
        Dim pCircDef As CircularPatternFeatureDefinition

        Dim oPatternRec As ObjectCollection
        Set oPatternRec = ThisApplication.TransientObjects.CreateObjectCollection
        Call oPatternRec.Add(partdef.Features(pRect.Name))
        
        Debug.Print pRect.Name
        Set pCircDef = partdef.Features.CircularPatternFeatures.CreateDefinition(oPatternRec, partdef.WorkAxes.Item(2), True, 6, "360 deg", True)
        Set pCirc = partdef.Features.CircularPatternFeatures.AddByDefinition(pCircDef)
        Dim oDegParam As ModelParameter
        Set oDegParam = partdef.Parameters.ModelParameters(partdef.Parameters.ModelParameters.Count)
        oDegParam.Expression = "360 deg" 'Set the angle again do to a bug
        pCirc.Name = "Circ_Pattern_" & point_star
        
        point_star = point_star + paso
    Loop
    
End Sub

Jhoel Forshav

Download my free Inventor Addin - Hole Projector

LinkedIn | Ideas | Contributions | Blog posts | Website

choncua · ‎06-03-2020

The Capture, Thanks

choncua · ‎06-03-2020

Thanks JhoelForshav

Thanks for your help, now it works, there is only a strange result in the last pattern, since the display does not appear correctly, and when editing the last pattern it is automatically corrected without the need to make any changes. it's strange.

attached images of the result and strange result

JhoelForshav · ‎06-03-2020

Hi @choncua

I just added the line ThisApplication.ActiveDocument.Rebuild at the very end of the sub and that seems to do it!

Public Sub SheetHole()
    Dim partdoc As PartDocument
    Set partdoc = ThisApplication.ActiveDocument
    Dim partdef As PartComponentDefinition
    Set partdef = partdoc.ComponentDefinition
    
    Dim sketch As PlanarSketch
    Set sketch = partdef.Sketches.Add(partdef.WorkPlanes.Item(2))
    sketch.Name = "Espejo"
    
    Dim oPoints As ObjectCollection
    Set oPoints = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim tg As TransientGeometry
    Set tg = ThisApplication.TransientGeometry
    
    Dim sum As Double
    Dim punto2 As SketchPoint
    Dim paso As Double
    Dim DE As Double
    Dim DI As Double
    Dim DE_Offset As Double
    Dim DI_Offset As Double
    Dim GAP As Double
    Dim point_star As Double
    Dim diahole As Double
    
    DE = 300.99
    DI = 71.12
        
    sum = (DI / 2)
    paso = 5.08
    
    point_star = paso
    
    diahole = 1.5
    
    Do While point_star < (DI / 2)
        point_star = point_star + paso
    Loop
    
    Dim cir_ext As SketchCircle
    Set cir_ext = sketch.SketchCircles.AddByCenterRadius(tg.CreatePoint2d(0, 0), (DE / 2))
    
    Dim diaDE As DiameterDimConstraint
    Set diaDE = sketch.DimensionConstraints.AddDiameter(cir_ext, tg.CreatePoint2d((DE / 2), (DE / 2)))
    
    Dim cir_int As SketchCircle
    Set cir_int = sketch.SketchCircles.AddByCenterRadius(tg.CreatePoint2d(0, 0), (DI / 2))
    
    ' Create a profile.
    Dim oProfile As Profile
    Set oProfile = sketch.Profiles.AddForSolid
    
    ' Create a base extrusion 1cm thick.
    Dim oExtrudeDef As ExtrudeDefinition
    Set oExtrudeDef = partdef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
    Call oExtrudeDef.SetDistanceExtent((1.25 * 2.54), kNegativeExtentDirection)
    Dim oExtrude As ExtrudeFeature
    Set oExtrude = partdef.Features.ExtrudeFeatures.Add(oExtrudeDef)
    oExtrude.Name = "Cuerpo Espejo"
    
    Do While point_star < (DE / 2)
        Set sketch = partdef.Sketches.Add(partdef.WorkPlanes.Item(2))
        sketch.Name = "Pattern_" & point_star
        
        Debug.Print point_star & ",0"
        Dim Pol As SketchEntitiesEnumerator
        Set Pol = sketch.SketchLines.AddAsPolygon(6, tg.CreatePoint2d(0, 0), tg.CreatePoint2d(point_star, 0), True)

        Dim oHoleFeatures As HoleFeatures
        Set oHoleFeatures = partdef.Features.HoleFeatures

        Dim oHole As HoleFeature

        Dim oHoleCenters As ObjectCollection
        Set oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection

        Set punto2 = sketch.SketchPoints.Add(tg.CreatePoint2d(point_star, 0), True)
        oHoleCenters.Add sketch.SketchPoints.Add(tg.CreatePoint2d(point_star, 0))
        
        Set oHole = partdef.Features.HoleFeatures.AddDrilledByThroughAllExtent(oHoleCenters, diahole & " in", kPositiveExtentDirection)
        
        oHole.Name = "Hole_" & point_star
        
        Dim pRectFeatures As RectangularPatternFeatures
        Set pRectFeatures = partdef.Features.RectangularPatternFeatures
        
        Dim pRect As RectangularPatternFeature
        
        Dim oFeatures As ObjectCollection
        Set oFeatures = ThisApplication.TransientObjects.CreateObjectCollection
        Call oFeatures.Add(oHole)
        
        Set pRect = partdef.Features.RectangularPatternFeatures.Add(oFeatures, partdef.WorkAxes.Item("Star_Guide_Work_Axis"), True, (point_star / paso), paso, kDefault, , partdef.WorkAxes.Item(2), False, 2, 9, kDefault, , kIdenticalCompute)
        
        pRect.Name = "HolePattern_" & point_star

        Dim pCircFeatures As CircularPatternFeatures
        Set pCircFeatures = partdef.Features.CircularPatternFeatures
        
        Dim pCirc As CircularPatternFeature
        Dim pCircDef As CircularPatternFeatureDefinition

        Dim oPatternRec As ObjectCollection
        Set oPatternRec = ThisApplication.TransientObjects.CreateObjectCollection
        Call oPatternRec.Add(partdef.Features(pRect.Name))
        
        Debug.Print pRect.Name
        Set pCircDef = partdef.Features.CircularPatternFeatures.CreateDefinition(oPatternRec, partdef.WorkAxes.Item(2), True, 6, "360 deg", True)
        Set pCirc = partdef.Features.CircularPatternFeatures.AddByDefinition(pCircDef)
        Dim oDegParam As ModelParameter
        Set oDegParam = partdef.Parameters.ModelParameters(partdef.Parameters.ModelParameters.Count)
        oDegParam.Expression = "360 deg" 'Set the angle again do to a bug
        pCirc.Name = "Circ_Pattern_" & point_star
        
        point_star = point_star + paso
    Loop
    ThisApplication.ActiveDocument.Rebuild
End Sub

Jhoel Forshav

Download my free Inventor Addin - Hole Projector

LinkedIn | Ideas | Contributions | Blog posts | Website

choncua · ‎06-03-2020

Thanks JhoelForshav

It Works Perfectly!

Best Regards!

Community

Method Add of object 'CircularPattern'

Method Add of object 'CircularPattern'

Method Add of object 'CircularPattern'