DirectShape

' Create a DirectShape Sphere
Public Sub CreateSphereDirectShape(doc As Document)
    Dim profile As New List(Of Curve)()

    ' first create sphere with 2' radius
    Dim center As XYZ = XYZ.Zero
    Dim radius As Double = 2.0
    Dim profile00 As XYZ = center
    Dim profilePlus As XYZ = center + New XYZ(0, radius, 0)
    Dim profileMinus As XYZ = center - New XYZ(0, radius, 0)

    profile.Add(Line.CreateBound(profilePlus, profileMinus))
    profile.Add(Arc.Create(profileMinus, profilePlus, center + New XYZ(radius, 0, 0)))

    Dim curveLoop__1 As CurveLoop = CurveLoop.Create(profile)
    Dim options As New SolidOptions(ElementId.InvalidElementId, ElementId.InvalidElementId)

    Dim frame__2 As New Frame(center, XYZ.BasisX, -XYZ.BasisZ, XYZ.BasisY)
    If Frame.CanDefineRevitGeometry(frame__2) = True Then
        Dim sphere As Solid = GeometryCreationUtilities.CreateRevolvedGeometry(frame__2, New CurveLoop() {curveLoop__1}, 0, 2 * Math.PI, options)
        Using t As New Transaction(doc, "Create sphere direct shape")
            t.Start()
            ' create direct shape and assign the sphere shape
            Dim ds As DirectShape = DirectShape.CreateElement(doc, New ElementId(BuiltInCategory.OST_GenericModel))

            ds.ApplicationId = "Application id"
            ds.ApplicationDataId = "Geometry object id"
            ds.SetShape(New GeometryObject() {sphere})
            t.Commit()
        End Using
    End If
End Sub