Create a Work Axis in Inventor VBA using AddByTwoPoints Method

[Anonymous]

Hello,

I would like to create a cut extrusion on an extruded part and then chamfer all edges on the top face of the extrusion using Autdesk Inventor VBA. I am able to create the cut extrusion but I am placing the chamfer on the bottom of the extrusion and not the top. The names and descriptions of attached jpgs illustrate what I am trying to accomplish:

1. BeforeRunningVBACutExtrude.jpg: Part before running VBA
2. AfterRunningVBACutExtrude.JPG: Part after running VBA where chamfer is not placed in the right location.
3. DesiredAfterRunningVBACutExtrude.JPG: How I want the part to look like after I run the vba code

Here is the vba code:

Sub CreateIndentation()
    'This sub creates an indentation on the plane named IndentPlane
    'User creates a plane and names it 'IndentPlane'
    Dim oPDoc As PartDocument
    Set oPDoc = ThisApplication.ActiveDocument
    
    Dim oPDef As PartComponentDefinition
    Set oPDef = oPDoc.ComponentDefinition
    
    'Loop Through planes of model and find plane named 'IndentPlane'
    Dim oWP As WorkPlane
    Dim oExists As Boolean
    For Each oWP In oPDef.WorkPlanes
        If oWP.Name = "IndentPlane" Then
            oExists = True
            Exit For
        End If
    Next
    
    If oExists = False Then
        Call MsgBox("WorkPlane named ""IndentPlane"" was not found. Exiting.", , "")
        Exit Sub
    End If

    Dim oSketch As Inventor.PlanarSketch
    Set oSketch = oPDef.Sketches.Add(oWP)

    'Create transGeom
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    
    '1: Create and Define four points of Rectangle
    Dim D1, D2 As Double
    D1 = 0.3
    D2 = 1.25
    Dim oCoord1 As Point2d
    Set oCoord1 = oTG.CreatePoint2d(D1, D1)
    Dim oCoord2 As Point2d
    Set oCoord2 = oTG.CreatePoint2d(D2, D1)
    Dim oCoord3 As Point2d
    Set oCoord3 = oTG.CreatePoint2d(D2, D2)
    Dim oCoord4 As Point2d
    Set oCoord4 = oTG.CreatePoint2d(D1, D2)

    '1b: Create four lines
    Dim oLine(1 To 4) As SketchLine
    
    'Define Four Lines
    Set oLine(1) = oSketch.SketchLines.AddByTwoPoints(oCoord1, oCoord2)
    Set oLine(2) = oSketch.SketchLines.AddByTwoPoints(oCoord2, oCoord3)
    Set oLine(3) = oSketch.SketchLines.AddByTwoPoints(oCoord3, oCoord4)
    Set oLine(4) = oSketch.SketchLines.AddByTwoPoints(oCoord4, oCoord1)
    
    'Define and Create 8 points for filleting
    Dim radFilSize As Double
    radFilSize = 0.3
    Dim oInputPt1 As Point2d
    Set oInputPt1 = oTG.CreatePoint2d(D2 - radFilSize, D1)
    Dim oInputPt2 As Point2d
    Set oInputPt2 = oTG.CreatePoint2d(D2, D1 + radFilSize)
    
    Dim oInputPt3 As Point2d
    Set oInputPt3 = oTG.CreatePoint2d(D2, D2 - radFilSize)
    Dim oInputPt4 As Point2d
    Set oInputPt4 = oTG.CreatePoint2d(D2 - radFilSize, D2)
    
    Dim oInputPt5 As Point2d
    Set oInputPt5 = oTG.CreatePoint2d(D1 + radFilSize, D2)
    Dim oInputPt6 As Point2d
    Set oInputPt6 = oTG.CreatePoint2d(D1, D2 - radFilSize)
    
    Dim oInputPt7 As Point2d
    Set oInputPt7 = oTG.CreatePoint2d(D1, D2 + radFilSize)
    Dim oInputPt8 As Point2d
    Set oInputPt8 = oTG.CreatePoint2d(D1 + radFilSize, D1)
    
    'Create saArc and Define four fillets of Rectangle
    Dim saArc As SketchArc
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(1), oLine(2), radFilSize, oInputPt1, oInputPt2)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(2), oLine(3), radFilSize, oInputPt3, oInputPt4)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(3), oLine(4), radFilSize, oInputPt5, oInputPt6)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(4), oLine(1), radFilSize, oInputPt7, oInputPt8)
    
    'Create and define Profile for extrusion
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid

    'Create Cut Extrusion that is 1 cm deep
    Dim oEDef As ExtrudeDefinition
    Set oEDef = oPDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
    Call oEDef.SetDistanceExtent(1, kNegativeExtentDirection)
    Dim oExtrude1 As ExtrudeFeature
    Set oExtrude1 = oPDef.Features.ExtrudeFeatures.Add(oEDef)

    'Create oEdges Collection
    Dim oEdges As EdgeCollection
    Set oEdges = ThisApplication.TransientObjects.CreateEdgeCollection
    
    'This print call shows that there is only one face belonging to oExtrude1 which is the bottom face
    Debug.Print oExtrude1.EndFaces.Count
    
    Call oEdges.Add(oExtrude1.EndFaces.Item(1).EdgeLoops.Item(1).Edges.Item(1))
        
    'Create Chamfer on last Edge
    Dim oChamfer As ChamferFeature
    Set oChamfer = oPDef.Features.ChamferFeatures.AddUsingDistance(oEdges, 0.05, False, False, False)
End Sub

[Anonymous]

I accidently created a duplicate post with different titles. Is there a way to delete this post?! 

[WCrihfield · Accepted solution]

Here is a version of your posted code that will chamfer around the bottom edges of the extruded pocket.

Sub CreateIndentation()
    'This sub creates an indentation on the plane named IndentPlane
    'User creates a plane and names it 'IndentPlane'
    Dim oPDoc As PartDocument
    Set oPDoc = ThisApplication.ActiveDocument
    
    Dim oPDef As PartComponentDefinition
    Set oPDef = oPDoc.ComponentDefinition
    
    'Loop Through planes of model and find plane named 'IndentPlane'
    Dim oWP As WorkPlane
    Dim oExists As Boolean
    For Each oWP In oPDef.WorkPlanes
        If oWP.Name = "IndentPlane" Then
            oExists = True
            Exit For
        End If
    Next
    
    If oExists = False Then
        Call MsgBox("WorkPlane named ""IndentPlane"" was not found. Exiting.", , "")
        Exit Sub
    End If

    Dim oSketch As Inventor.PlanarSketch
    Set oSketch = oPDef.Sketches.Add(oWP)

    'Create transGeom
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    
    '1: Create and Define four points of Rectangle
    Dim D1, D2 As Double
    D1 = 0.3
    D2 = 1.25
    Dim oCoord1 As Point2d
    Set oCoord1 = oTG.CreatePoint2d(D1, D1)
    Dim oCoord2 As Point2d
    Set oCoord2 = oTG.CreatePoint2d(D2, D1)
    Dim oCoord3 As Point2d
    Set oCoord3 = oTG.CreatePoint2d(D2, D2)
    Dim oCoord4 As Point2d
    Set oCoord4 = oTG.CreatePoint2d(D1, D2)

    '1b: Create four lines
    Dim oLine(1 To 4) As SketchLine
    
    'Define Four Lines
    Set oLine(1) = oSketch.SketchLines.AddByTwoPoints(oCoord1, oCoord2)
    Set oLine(2) = oSketch.SketchLines.AddByTwoPoints(oCoord2, oCoord3)
    Set oLine(3) = oSketch.SketchLines.AddByTwoPoints(oCoord3, oCoord4)
    Set oLine(4) = oSketch.SketchLines.AddByTwoPoints(oCoord4, oCoord1)
    
    'Define and Create 8 points for filleting
    Dim radFilSize As Double
    radFilSize = 0.3
    Dim oInputPt1 As Point2d
    Set oInputPt1 = oTG.CreatePoint2d(D2 - radFilSize, D1)
    Dim oInputPt2 As Point2d
    Set oInputPt2 = oTG.CreatePoint2d(D2, D1 + radFilSize)
    
    Dim oInputPt3 As Point2d
    Set oInputPt3 = oTG.CreatePoint2d(D2, D2 - radFilSize)
    Dim oInputPt4 As Point2d
    Set oInputPt4 = oTG.CreatePoint2d(D2 - radFilSize, D2)
    
    Dim oInputPt5 As Point2d
    Set oInputPt5 = oTG.CreatePoint2d(D1 + radFilSize, D2)
    Dim oInputPt6 As Point2d
    Set oInputPt6 = oTG.CreatePoint2d(D1, D2 - radFilSize)
    
    Dim oInputPt7 As Point2d
    Set oInputPt7 = oTG.CreatePoint2d(D1, D2 + radFilSize)
    Dim oInputPt8 As Point2d
    Set oInputPt8 = oTG.CreatePoint2d(D1 + radFilSize, D1)
    
    'Create saArc and Define four fillets of Rectangle
    Dim saArc As SketchArc
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(1), oLine(2), radFilSize, oInputPt1, oInputPt2)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(2), oLine(3), radFilSize, oInputPt3, oInputPt4)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(3), oLine(4), radFilSize, oInputPt5, oInputPt6)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(4), oLine(1), radFilSize, oInputPt7, oInputPt8)
    
    'Create and define Profile for extrusion
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid

    'Create Cut Extrusion that is 1 cm deep
    Dim oEDef As ExtrudeDefinition
    Set oEDef = oPDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
    Call oEDef.SetDistanceExtent(1, kNegativeExtentDirection)
    Dim oExtrude1 As ExtrudeFeature
    Set oExtrude1 = oPDef.Features.ExtrudeFeatures.Add(oEDef)

    'Create oEdges Collection
    Dim oEdges As EdgeCollection
    Set oEdges = ThisApplication.TransientObjects.CreateEdgeCollection
    
    'This print call shows that there is only one face belonging to oExtrude1 which is the bottom face
    Debug.Print oExtrude1.EndFaces.Count
    
    Dim oELoop As Inventor.EdgeLoop
    Dim oEdge As Inventor.Edge
    For Each oELoop In oExtrude1.EndFaces.Item(1).EdgeLoops
        If oELoop.IsOuterEdgeLoop Then
            For Each oEdge In oELoop.Edges
                Call oEdges.Add(oEdge)
            Next
        End If
    Next
        
    'Create Chamfer on last Edge
    Dim oChamfer As ChamferFeature
    Set oChamfer = oPDef.Features.ChamferFeatures.AddUsingDistance(oEdges, 0.05, False, False, False)
End Sub

However, getting the top edges may be a bit trickier, especially since we're starting the extrude feature on a WorkPlane instead of a Face.  Look at how I'm adding the edges to the EdgeCollection in the example above.  Basically you would need to get that face (the one the plane is on), then loop through its EdgeLoops (likely only two at this point, the face's original edges and the new extruded hole), and if (IsOuterEdgeLoop) = False, then that is the one we want.  Then loop through that EdgeLoop's Edges, adding each one to the EdgeCollection, similar to the example above.

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click 'LIKE' 👍.

If you have time, please... Vote For My IDEAS 💡or you can Explore My CONTRIBUTIONS

Inventor 2021 Help | Inventor Forum | Inventor Customization Forum | Inventor Ideas Forum

[Anonymous]

Yes! I am trying to place a chamfer on the top edge and will use your suggestion to get the edge loop of the face that is coplanar to the 'indentplane'. However, I am having some difficulty identifying that top face. I tried to create a sub that loops through all of the faces under surfacebodies.item(1), create a work plane using addbyoffset method, convert that work plane, to a plane, check if the plane is coplanar to 'indentplane'

However, I am not able to create a workplane using addbyoffset method on the face object. Is this the proper way to create a workplane using the face object? Please see vba code below:

Public Sub LoopThroughFacesAndFindFaceCoPlanarToIndentPlane()
    Dim oPDoc As PartDocument
    Set oPDoc = ThisApplication.ActiveDocument
    
    Dim oPDef As PartComponentDefinition
    Set oPDef = oPDoc.ComponentDefinition
    
    Dim oFaces As Faces
    Set oFaces = oPDef.SurfaceBodies.Item(1).Faces
    Debug.Print oFaces.Count
    
    'Loop Through planes of model and find plane named 'IndentPlane'
    Dim oWP As WorkPlane
    Dim oExists As Boolean
    For Each oWP In oPDef.WorkPlanes
        If oWP.Name = "IndentPlane" Then
            oExists = True
            Exit For
        End If
    Next
    
    Dim oWkPlanes As WorkPlanes
    Set oWkPlanes = oPDef.WorkPlanes
    
    Dim oWkPlane As WorkPlane
    Dim oPlane As Plane
    Dim oFace As Face
    For Each oFace In oFaces
        'Add code here that creates a plane from the face using AddByOffset Method of Workplanes
        'Check if that plane is coplanar to the plane in question
        Set oWkPlane = oWkPlanes.AddByPlaneAndOffset(oFace.Geometry, 0)
        Set oPlane = oWkPlane
        Debug.Print oPlane.IsCoplanarTo(oWP)
    Next
End Sub

[WCrihfield]

How was the "IndentPlane" created? If it was created manually, was it created as a zero offset workplane on the face?  Offset from a origin plane?  etc.

If zero offset, and the face was selected when created, we may be able to use that knowledge to get the face it was offset from.

[Anonymous]

Yes it was offset from the top face by the user (myself)!

[_dscholtes_]

---

@Anonymous wrote:

 I tried to create a sub that loops through all of the faces under surfacebodies.item(1), create a work plane using addbyoffset method, convert that work plane, to a plane, check if the plane is coplanar to 'indentplane'

There's no need for this complicated route. Every face has a normal (vector) which should be perpendicular to the 'indentplane' when the face is parallel to the '' indent plane'.  

[WCrihfield · Accepted solution]

I have modified the last version of the code I posted, so that it will now chamfer around the top edge of the extruded pocket, instead of around its bottom edge.  I am also showing how to use the IsCoplanarTo() function.  It can be tricky when dealing with faces, because each face's surface/geometry needs to be checked to make sure it is compatible, then you have to define it as the right Type of object, so that it is accepted by the function as its required input variable.

You'll notice that as soon as I've found it in the loop, I'm exiting the For loop.  This preserves the oFace (and the oFPlane) variable(s) values, as they were set in that loop.  Then I use oFace in the loop at the bottom, which adds the edges to the collection.  You will also notice I included the word Not in it's check, because this time I don't want to get the 'outer' edgeloop, I want the only inner one.

Here is the updated macro code.

Sub CreateIndentation()
    'This sub creates an indentation on the plane named IndentPlane
    'User creates a plane and names it 'IndentPlane'
    Dim oPDoc As PartDocument
    Set oPDoc = ThisApplication.ActiveDocument
    
    Dim oPDef As PartComponentDefinition
    Set oPDef = oPDoc.ComponentDefinition
    
    'Loop Through planes of model and find plane named 'IndentPlane'
    Dim oWP As WorkPlane
    Dim oExists As Boolean
    For Each oWP In oPDef.WorkPlanes
        If oWP.Name = "IndentPlane" Then
            oExists = True
            Exit For
        End If
    Next
    If oExists = False Then
        Call MsgBox("WorkPlane named ""IndentPlane"" was not found. Exiting.", , "")
        Exit Sub
    End If
    
    Dim oFace As Inventor.Face
    Dim oFPlane As Inventor.Plane
    Dim oFound As Boolean
    For Each oFace In oPDef.SurfaceBodies.Item(1).Faces
        If oFace.SurfaceType = kPlaneSurface Then
            Set oFPlane = oFace.Geometry
            If oWP.Plane.IsCoplanarTo(oFPlane) Then
                oFound = True
                Exit For
            End If
        End If
    Next
    If oFound = False Then
        Call MsgBox("The face was not found. Exiting.", , "")
        Exit Sub
    End If
    
    Dim oSketch As Inventor.PlanarSketch
    Set oSketch = oPDef.Sketches.Add(oWP)

    'Create transGeom
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    
    '1: Create and Define four points of Rectangle
    Dim D1, D2 As Double
    D1 = 0.3
    D2 = 1.25
    Dim oCoord1 As Point2d
    Set oCoord1 = oTG.CreatePoint2d(D1, D1)
    Dim oCoord2 As Point2d
    Set oCoord2 = oTG.CreatePoint2d(D2, D1)
    Dim oCoord3 As Point2d
    Set oCoord3 = oTG.CreatePoint2d(D2, D2)
    Dim oCoord4 As Point2d
    Set oCoord4 = oTG.CreatePoint2d(D1, D2)

    '1b: Create four lines
    Dim oLine(1 To 4) As SketchLine
    
    'Define Four Lines
    Set oLine(1) = oSketch.SketchLines.AddByTwoPoints(oCoord1, oCoord2)
    Set oLine(2) = oSketch.SketchLines.AddByTwoPoints(oCoord2, oCoord3)
    Set oLine(3) = oSketch.SketchLines.AddByTwoPoints(oCoord3, oCoord4)
    Set oLine(4) = oSketch.SketchLines.AddByTwoPoints(oCoord4, oCoord1)
    
    'Define and Create 8 points for filleting
    Dim radFilSize As Double
    radFilSize = 0.3
    Dim oInputPt1 As Point2d
    Set oInputPt1 = oTG.CreatePoint2d(D2 - radFilSize, D1)
    Dim oInputPt2 As Point2d
    Set oInputPt2 = oTG.CreatePoint2d(D2, D1 + radFilSize)
    
    Dim oInputPt3 As Point2d
    Set oInputPt3 = oTG.CreatePoint2d(D2, D2 - radFilSize)
    Dim oInputPt4 As Point2d
    Set oInputPt4 = oTG.CreatePoint2d(D2 - radFilSize, D2)
    
    Dim oInputPt5 As Point2d
    Set oInputPt5 = oTG.CreatePoint2d(D1 + radFilSize, D2)
    Dim oInputPt6 As Point2d
    Set oInputPt6 = oTG.CreatePoint2d(D1, D2 - radFilSize)
    
    Dim oInputPt7 As Point2d
    Set oInputPt7 = oTG.CreatePoint2d(D1, D2 + radFilSize)
    Dim oInputPt8 As Point2d
    Set oInputPt8 = oTG.CreatePoint2d(D1 + radFilSize, D1)
    
    'Create saArc and Define four fillets of Rectangle
    Dim saArc As SketchArc
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(1), oLine(2), radFilSize, oInputPt1, oInputPt2)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(2), oLine(3), radFilSize, oInputPt3, oInputPt4)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(3), oLine(4), radFilSize, oInputPt5, oInputPt6)
    Set saArc = oSketch.SketchArcs.AddByFillet(oLine(4), oLine(1), radFilSize, oInputPt7, oInputPt8)
    
    'Create and define Profile for extrusion
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid

    'Create Cut Extrusion that is 1 cm deep
    Dim oEDef As ExtrudeDefinition
    Set oEDef = oPDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
    Call oEDef.SetDistanceExtent(1, kNegativeExtentDirection)
    Dim oExtrude1 As ExtrudeFeature
    Set oExtrude1 = oPDef.Features.ExtrudeFeatures.Add(oEDef)

    'Create oEdges Collection
    Dim oEdges As EdgeCollection
    Set oEdges = ThisApplication.TransientObjects.CreateEdgeCollection
    
    Dim oELoop As Inventor.EdgeLoop
    Dim oEdge As Inventor.Edge
    For Each oELoop In oFace.EdgeLoops
        If Not oELoop.IsOuterEdgeLoop Then
            For Each oEdge In oELoop.Edges
                Call oEdges.Add(oEdge)
            Next
        End If
    Next
        
    'Create Chamfer on last Edge
    Dim oChamfer As ChamferFeature
    Set oChamfer = oPDef.Features.ChamferFeatures.AddUsingDistance(oEdges, 0.05, False, False, False)
End Sub

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click 'LIKE' 👍.

[WCrihfield]

@Anonymous 

If you had the latest version of Inventor, there is also the NamedEntities route too.  Basically, you can simply select & right click on any face, edge, vertex, etc in the model area, then choose "Assign Name...".  Type in a name for it.  (This adds an Attribute to it.)  Then in the code, access the iLogic Add-in's Automation, and its GetNamedEntities function, which returns the NamedEntities interface (the collection of all named faces, edges, vertices), which has its own set of properties and methods for working with it.  Although it may not be as efficient to use it from VBA, it is possible, if it's available in your version of Inventor.  (Since it uses Attributes, you can also use that route to get your named face, if using the NamedEntities route is not desired.)

IiLogicAutomation.GetNamedEntities Method

NamedEntities Interface 

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click 'LIKE' 👍.