Projecting Points Onto a Solid

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 tem
pNormal.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:TempPoints.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:TempPoints.csv"""    Else        MsgBox "Invalid Input"    End IfEnd 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