Create Sphere by Three Points

By Xiaodong Liang

This is a question of math, but I think it may help for some developers who may not have time to dig into by Inventor API. The VBA code below is written by my colleague Brian Ekins long time ago for one case. It self explains the workflow.

Public Sub TestSphere()

    Dim oTG As TransientGeometry

    Set oTG = ThisApplication.TransientGeometry

   

    ‘prepare 3 points

    Dim oPoint1 As Point

    Set oPoint1 = oTG.CreatePoint(0, 10, 0.1)

    Dim oPoint2 As Point

    Set oPoint2 = oTG.CreatePoint(0, 10.1, 0.2)

    Dim oPoint3 As Point

    Set oPoint3 = oTG.CreatePoint(0, 10.2, 0.4)

   

    Dim oCompDef As PartComponentDefinition

    Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition

   

    ‘create the sphere

    Dim oSphere As RevolveFeature

    Set oSphere = CreateSphere(oCompDef, oPoint1, oPoint2, oPoint3)

End Sub

 

Public Function CreateSphere(PartCompDef As PartComponentDefinition, Pnt1 As Point, Pnt2 As Point, Pnt3 As Point) As RevolveFeature

    Dim oTG As TransientGeometry

    Set oTG = ThisApplication.TransientGeometry

   

    ‘ Calculate the normal of the plane defined by the three points.

    Dim oVec1 As UnitVector

    Set oVec1 = oTG.CreateUnitVector(Pnt2.X – Pnt1.X, Pnt2.Y – Pnt1.Y, Pnt2.Z – Pnt1.Z)

    Dim oVec2 As UnitVector

    Set oVec2 = oTG.CreateUnitVector(Pnt3.X – Pnt1.X, Pnt3.Y – Pnt1.Y, Pnt3.Z – Pnt1.Z)

   

    If oVec1.IsParallelTo(oVec2) Then

        MsgBox "The three points are collinear"

        Exit Function

    End If

   

    Dim oNormalVec As UnitVector

    Set oNormalVec = oVec1.CrossProduct(oVec2)

   

    ‘ Use vector one as the X axis of the plane, but calculate

    ‘ a new Y axis.

    Set oVec2 = oNormalVec.CrossProduct(oVec1)

   

    ‘ Create a fixed work plane and make it invisible.

    Dim oWP As WorkPlane

    Set oWP = PartCompDef.WorkPlanes.AddFixed(Pnt1, oVec1, oVec2)

    oWP.Visible = False

   

    ‘ Create a sketch.

    Dim oSketch As PlanarSketch

    Set oSketch = PartCompDef.Sketches.Add(oWP)

   

    ‘ Create an arc through the three input points.

    Dim oArc As SketchArc

    Set oArc = oSketch.SketchArcs.AddByThreePoints(oSketch.ModelToSketchSpace(Pnt1), _

                    oSketch.ModelToSketchSpace(Pnt2), oSketch.ModelToSketchSpace(Pnt3))

   

    Call oSketch.GeometricConstraints.AddGround(oArc.CenterSketchPoint)

    Call oSketch.GeometricConstraints.AddGround(oArc.StartSketchPoint)

   

    ‘ Calculate the required position of the end point to get a 180 degree sweep.

    Dim dEndAngle As Double

    dEndAngle = oArc.StartAngle + Val("3.1415926535897932384626433832795")

   

    Dim oNewPoint As Point2d

    Set oNewPoint = oTG.CreatePoint2d(oArc.Radius * Cos(dEndAngle) + oArc.CenterSketchPoint.Geometry.X, _

                                      oArc.Radius * Sin(dEndAngle) + oArc.CenterSketchPoint.Geometry.Y)

   

    ‘ Move the point.

    oArc.EndSketchPoint.MoveTo oNewPoint

   

    ‘ Connect the start and end points with a line.

    Dim oLine As SketchLine

    Set oLine = oSketch.SketchLines.AddByTwoPoints(oArc.StartSketchPoint, oArc.EndSketchPoint)

   

    ‘ Create the revolved feature.

    Dim oProfile As Profile

    Set oProfile = oSketch.Profiles.AddForSolid

    Set CreateSphere = PartCompDef.Features.RevolveFeatures.AddFull(oProfile, oLine, kJoinOperation)

<

p style=”line-height: normal;margin: 0cm 0cm 0pt” class=”MsoNormal” align=”justify”>End Function