There was a recent Inventor question posted on stackoverflow that I thought was interesting and decided to look at. The question involved being able to project points from a sketch onto a solid. Below is a picture of a sketch that contains many sketch center points. In this case they were created by patterning a point to get a grid of points but they could be created in any way. The goal is to project all of these points onto the solid. For my program I chose to project them in the direction that is perpendicular (normal) to the sketch plane.

Here’s the result where the intersection points are created as work points.

The sketch can be in any orientation in space, as shown in the picture below. In this case the results were created as points within a 3D sketch.

And here’s the VBA code that I came up with to do this. It asks for the selection of a sketch (which you need to pick in the browser) and for a body. The next section of code is the most confusing but it’s basically trying to determine where the selected sketch is relative to the selected body and then computing a value so that when it begins projecting the points, the point it projects is outside of the solid. That’s actually the largest chunk of the code. Towards the bottom of the macro you’ll see where the actual intersection work takes place. It then prompts the user to select how to display the results where they can choose one of three ways; as work points, points in a 3D sketch, or written to a csv file.

Public Sub ProjectPoints()

**' Have the sketch that contains the points selected.** Dim sk As PlanarSketch

Set sk = ThisApplication.CommandManager.Pick(kSketchObjectFilter, _

"Select the sketch")

**' Have the body to project onto selected.**

Dim body As SurfaceBody

Set body = ThisApplication.CommandManager.Pick(kPartBodyFilter, _

"Select the body")

**' Get the part component definition.**

Dim compDef As PartComponentDefinition

Set compDef = body.Parent

**' *** Determine the side of the solid the sketch is on and if the**

**' *** sketch is outside the solid.**

**' Get the normal vector of the selected sketch.**

Dim skNormal As UnitVector

Set skNormal = sk.PlanarEntityGeometry.Normal

Dim skRootPoint As Point

Set skRootPoint = sk.PlanarEntityGeometry.RootPoint

**' Get the corners of the range box.**

Dim tg As TransientGeometry

Set tg = ThisApplication.TransientGeometry

Dim cornerPoints(7) As Point

Dim range As Box

Set range = body.RangeBox

Set cornerPoints(0) = range.MinPoint

Set cornerPoints(1) = tg.CreatePoint(range.MinPoint.x, range.MinPoint.y, _

range.MaxPoint.Z)

Set cornerPoints(2) = tg.CreatePoint(range.MinPoint.x, range.MaxPoint.y, _

range.MinPoint.Z)

Set cornerPoints(3) = tg.CreatePoint(range.MinPoint.x, range.MaxPoint.y, _

range.MaxPoint.Z)

Set cornerPoints(4) = range.MaxPoint

Set cornerPoints(5) = tg.CreatePoint(range.MaxPoint.x, range.MinPoint.y, _

range.MaxPoint.Z)

Set cornerPoints(6) = tg.CreatePoint(range.MaxPoint.x, range.MinPoint.y, _

range.MinPoint.Z)

Set cornerPoints(7) = tg.CreatePoint(range.MaxPoint.x, range.MaxPoint.y, _

range.MinPoint.Z)

**' Construct a matrix where the X axis is along the sketch plane normal.**

Dim xAxis As Vector

Set xAxis = skNormal.AsVector

Dim yAxis As Vector

Set yAxis = tg.CreateVector(xAxis.x + 1, xAxis.y + 1, xAxis.Z + 1)

Dim zAxis As Vector

Set zAxis = xAxis.CrossProduct(yAxis)

Set yAxis = zAxis.CrossProduct(xAxis)

xAxis.Normalize

yAxis.Normalize

zAxis.Normalize

Dim transform As Matrix

Set transform = tg.CreateMatrix

Call transform.SetCoordinateSystem(skRootPoint, xAxis, yAxis, zAxis)

transform.Invert

**' Transform the range box points and compare them to sketch plane.**

Dim i As Integer

Dim smallX As Double

For i = 0 To 7

Call cornerPoints(i).TransformBy(transform)

If i = 0 Then

smallX = cornerPoints(i).x

Else

If cornerPoints(i).x < smallX Then

smallX = cornerPoints(i).x

End If

End If

Next

**' Determine the offset needed to position the points outside the solid.**

Dim offset As Double

If smallX < 0 Then

offset = -(smallX + 10)

Dim tempNormal As Vector

Set tempNormal = skNormal.AsVector

Call tempNormal.ScaleBy(-1)

Set skNormal = tempNormal.AsUnitVector

Else

offset = 0

End If

Dim offsetVector As Vector

Set offsetVector = skNormal.AsVector

Call offsetVector.ScaleBy(offset)

**' *** Perform the intersection calculation of every center point in the sketch.**

Dim resultPoints As ObjectCollection

Set resultPoints = ThisApplication.TransientObjects.CreateObjectCollection

Dim skPoint As SketchPoint

For Each skPoint In sk.SketchPoints

**' Check to see if the point is a center point.**

If skPoint.HoleCenter Then

**' Get the sketch point as a transient 3D point.**

Dim pnt As Point

Set pnt = skPoint.Geometry3d

**' Move the point outside the solid.**

Call pnt.TranslateBy(offsetVector)

**' Intersect the point with the solid.**

Dim foundEnts As ObjectsEnumerator

Dim locPoints As ObjectsEnumerator

Call body.FindUsingRay(pnt, skNormal, 0.00001, foundEnts, locPoints, True)

**' If an intersection was found, add it to the list.**

If locPoints.count > 0 Then

Call resultPoints.Add(locPoints.Item(1))

End If

End If

Next

**' Prompt the user for which type of output they want.**

Dim result As String

result = InputBox("Enter choice for output:" & vbCrLf & "1 - Work points" & _

vbCrLf & "2 - 3D sketch" & vbCrLf & "3 - csv File", _

"Enter output type", 3)

If result = "1" Or result = "2" Then

**' Start a transaction so that the creation is grouped in a single undo.**

Dim trans As Transaction

Set trans = ThisApplication.TransactionManager.StartTransaction( _

ThisApplication.ActiveDocument, "Projected Points")

If result = "1" Then

**' Create work points.**

For i = 1 To resultPoints.count

Call compDef.WorkPoints.AddFixed(resultPoints.Item(i))

Next

End If

If result = "2" Then

**' Create a 3D sketch and points in the sketch.**

Dim sk3D As Sketch3D

Set sk3D = compDef.Sketches3D.Add()

For i = 1 To resultPoints.count

Call sk3D.SketchPoints3D.Add(resultPoints.Item(i))

Next

End If

trans.End

ElseIf result = "3" Then

**' Write the points out to a file.**

Open "C:\Temp\Points.csv" For Output As #1

For i = 1 To resultPoints.count

Print #1, Format(resultPoints.Item(i).x, "0.00000000") & "," & _

Format(resultPoints.Item(i).y, "0.00000000") & "," & _

Format(resultPoints.Item(i).Z, "0.00000000")

Next

Close #1

MsgBox "File written to ""C:\Temp\Points.csv"""

Else

MsgBox "Invalid Input"

End If

End Sub

Hopefully this is useful as a starting point for something you might want to do. It at least demonstrates a couple of interesting things.

This is all Inventor but for those of you using Fusion, Fusion doesn’t currently have the API functionality to fire a ray through the model so this can’t be done in the same way. I do expect that to be available at some point in the future though.

-Brian