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
Subscribe