Rectangular pattern with direction by sketch line

[AlbertoOutline]

I need to create by VBA code a rectangular pattern allineated to a line in the sketch.

I'm not able to use the line as direction.

Can anybody help me to solve the problem?

This is a sample code.

Thank in advance

Public Sub RectPatternWithDirectionBySketchLine()

Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, _
ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))

' Set a reference to the component definition.
Dim oCompDef As PartComponentDefinition
Set oCompDef = oPartDoc.ComponentDefinition

' Create a new sketch on the X-Y work plane.
Dim oSketch As PlanarSketch
Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes(3))

' Set a reference to the transient geometry object.
Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry

' Draw a 4cm x 3cm rectangle with the corner at (0,0)
Dim oRectangleLines As SketchEntitiesEnumerator
Set oRectangleLines = oSketch.SketchLines.AddAsTwoPointRectangle(oTransGeom.CreatePoint2d(0, 0), oTransGeom.CreatePoint2d(4, 3))

' Create a profile.
Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid

' Create a base extrusion 1cm thick.
Dim oExtrudeDef As ExtrudeDefinition
Set oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
Call oExtrudeDef.SetDistanceExtent(1, kNegativeExtentDirection)
Dim oExtrude1 As ExtrudeFeature
Set oExtrude1 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)

' Get the top face of the extrusion to use for creating the new sketch.
Dim oFrontFace As Face
Set oFrontFace = oExtrude1.StartFaces.Item(1)

' Create a new sketch on this face, but use the method that allows you to
' control the orientation and orgin of the new sketch.
Set oSketch = oCompDef.Sketches.Add(oFrontFace)

'Create and define center of circle
Dim oCoord1 As Point2d
Set oCoord1 = oTransGeom.CreatePoint2d(1, 1)
Dim oCircle As SketchCircle
Set oCircle = oSketch.SketchCircles.AddByCenterRadius(oCoord1, 0.2)

'Create line for pattern direction
Dim oCoord2 As Point2d
Dim oLine As SketchLine
Set oCoord2 = oTransGeom.CreatePoint2d(3, 2)
Set oLine = oSketch.SketchLines.AddByTwoPoints(oCoord1, oCoord2)

'Create and define Profile for extrusion
Set oProfile = oSketch.Profiles.AddForSolid

'Create cut extrusion
Set oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
Call oExtrudeDef.SetThroughAllExtent(kNegativeExtentDirection)
Dim oExtrude2 As ExtrudeFeature
Set oExtrude2 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)

'Create rectangular pattern
Dim objColl As ObjectCollection
Dim oRectPatternDef As RectangularPatternFeatureDefinition
Dim oRectPattern As RectangularPatternFeature
Set objColl = ThisApplication.TransientObjects.CreateObjectCollection
Call objColl.Add(oExtrude2)

'Create rectangular pattern with X Axis direction
' /// Set oRectPatternDef = oCompDef.Features.RectangularPatternFeatures.CreateDefinition(objColl, oCompDef.WorkAxes(1), True, 5, 0.5)
' ////Set oRectPattern = oCompDef.Features.RectangularPatternFeatures.AddByDefinition(oRectPatternDef)

'Create rectangular pattern with sketch line direction
Dim OLineDirection As GeometryIntent
Set OLineDirection = oCompDef.CreateGeometryIntent(oLine)
Set oRectPatternDef = oCompDef.Features.RectangularPatternFeatures.CreateDefinition(objColl, OLineDirection, True, 5, 0.5)
Set oRectPattern = oCompDef.Features.RectangularPatternFeatures.AddByDefinition(oRectPatternDef)

End Sub

[earl_cody · Accepted solution]

Hi @AlbertoOutline,

Try using a Path object instead of a GeometryIntent object for the RectangularPatternDefinition's XDirectionEntity.

I kept getting an error when creating the Path object (pathh) with the original oSketchLine, so I created another Sketch (sketch2) and SketchLine (line2) separate from the circle/hole sketch and that worked. I'm not 100% sure for why the original oSketchLine wouldn't work for the CreatePath input, but maybe it was trying to combine curves with the circle (oCircle) curve.

Reference:

https://forums.autodesk.com/t5/inventor-ilogic-and-vb-net-forum/rectangular-pattern-using-a-sketchli... 

...

Dim sketch2 As Inventor.PlanarSketch
Set sketch2 = oCompDef.Sketches.Add(oFrontFace)

Dim line2 As Inventor.SketchLine
Set line2 = sketch2.SketchLines.AddByTwoPoints(oCoord1, oCoord2)

Dim pathh As Inventor.path
Set pathh = oCompDef.Features.CreatePath(SketchCurve:=line2)

Set oRectPatternDef = oCompDef.Features.RectangularPatternFeatures.CreateDefinition( _
    ParentFeatures:=objColl, _
    XDirectionEntity:=pathh, _
    NaturalXDirection:=True, _
    XCount:=5, _
    XSpacing:=0.5)

Set oRectPattern = oCompDef.Features.RectangularPatternFeatures.AddByDefinition(oRectPatternDef)

End Sub

[AlbertoOutline]

Thanks @earl_cody 

[dominiek_vanwest]

@earl_cody 

Thanks for this information as it helped me a lot.

I kept getting the same error as you but I think I figured out why. If I was not in edit Sketch mode, then I got the error, but if I was in edit Sketch mode, I didn't get an error.

So adding this code to it should help:

oSketch.Edit

or you might have added the below code already in it. So just move this below the RectangularPatternFeature

oSketch.ExitEdit