Public Sub CreateNonPlanarSectionLoft()
' Create a new part document, using the default part template.
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, _
ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
Dim oCompDef As PartComponentDefinition
Set oCompDef = oPartDoc.ComponentDefinition
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
' Create a 2d sketch to use as one section.
Dim oSketch As PlanarSketch
Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes.Item(3))
Call oSketch.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 5)
' Create the profile to use as the section.
Dim oProfile1 As Profile
Set oProfile1 = oSketch.Profiles.AddForSolid
' Create a 3d sketch to use as the second section.
Dim oSketch3d As Sketch3D
Set oSketch3d = oCompDef.Sketches3D.Add
Dim oWPs(1 To 6) As WorkPoint
Set oWPs(1) = oCompDef.WorkPoints.AddFixed(oTG.CreatePoint(-8, 6, 10))
Set oWPs(2) = oCompDef.WorkPoints.AddFixed(oTG.CreatePoint(-8, -6, 10))
Set oWPs(3) = oCompDef.WorkPoints.AddFixed(oTG.CreatePoint(0, -4, 8))
Set oWPs(4) = oCompDef.WorkPoints.AddFixed(oTG.CreatePoint(8, -6, 10))
Set oWPs(5) = oCompDef.WorkPoints.AddFixed(oTG.CreatePoint(8, 6, 10))
Set oWPs(6) = oCompDef.WorkPoints.AddFixed(oTG.CreatePoint(0, 4, 8))
Dim oStartLine3d As SketchLine3D
Set oStartLine3d = oSketch3d.SketchLines3D.AddByTwoPoints(oWPs(1), oWPs(2), True, 2)
Dim oLine3d As SketchLine3D
Set oLine3d = oSketch3d.SketchLines3D.AddByTwoPoints(oStartLine3d.EndSketchPoint, oWPs(3), True, 2)
Set oLine3d = oSketch3d.SketchLines3D.AddByTwoPoints(oLine3d.EndSketchPoint, oWPs(4), True, 2)
Set oLine3d = oSketch3d.SketchLines3D.AddByTwoPoints(oLine3d.EndSketchPoint, oWPs(5), True, 2)
Set oLine3d = oSketch3d.SketchLines3D.AddByTwoPoints(oLine3d.EndSketchPoint, oWPs(6), True, 2)
Set oLine3d = oSketch3d.SketchLines3D.AddByTwoPoints(oLine3d.EndSketchPoint, oStartLine3d.StartSketchPoint, True, 2)
' Create a 3d profile to use as the section. Even though this section
' is closed the AddOpen method must be used because it is non-planar.
Dim oProfile2 As Profile3D
Set oProfile2 = oSketch3d.Profiles3D.AddOpen
' Create an object collection for the sections.
Dim oSections As ObjectCollection
Set oSections = ThisApplication.TransientObjects.CreateObjectCollection
Call oSections.Add(oProfile1)
Call oSections.Add(oProfile2)
' Create the loft definition. Because one of the ends isn't planar,
' a surface must be created instead of a solid.
Dim oLoftDefinition As LoftDefinition
Set oLoftDefinition = oCompDef.Features.LoftFeatures.CreateLoftDefinition(oSections, kSurfaceOperation)
' Create the loft feature.
Call oCompDef.Features.LoftFeatures.Add(oLoftDefinition)
End Sub
