'special note goto tools references and make sure GXExt8.0 Type Library is available
'It many be v7 v8 or v9 depending an what version you are running




Private Const PI = 3.1414592554

Private Const degtorad = 0.017453292


Private Type Ty3Dpoint
x As Double
y As Double

z As Double
End Type

Sub cone()

Dim BaseDia As Double

Dim height As Double


Dim s As String
s = InputBox("Base Dia", "Cone Properties", 100)

If s = "" Then Exit Sub
BaseDia = CDbl(s)

s = InputBox("Cone Height", "Cone Properties", 100)
If s = "" Then Exit Sub

height = CDbl(s)

drawcone BaseDia, height


End Sub


Sub ParboloaSlice()

Dim parabolaSliceAngle As Double

parabolaSliceAngle = Atn(100 / 50)

Dim c As Ty3Dpoint
c.x = 0
c.y = 0
c.z = 20

SliceAndDice c, parabolaSliceAngle

End Sub


Sub circleSlice()

Dim c As Ty3Dpoint
c.x = 0
c.y = 0
c.z = 85

SliceAndDice c, 0


End Sub


Sub ellipseSlice()

Dim c As Ty3Dpoint
c.x = 0
c.y = 0
c.z = 65

SliceAndDice c, 20 * degtorad
End Sub


Sub hyperbolaSlice()

Dim c As Ty3Dpoint
c.x = 30
c.y = 0
c.z = 100

SliceAndDice c, 90 * degtorad

End Sub

Private Sub SliceAndDice(planecentroid As Ty3Dpoint, sliceAngle As Double)

Dim coneID As Long
Dim PlaneID As Long


coneID = drawcone(100, 100)
PlaneID = drawplane(planecentroid, 0, sliceAngle, 210, 0.5)

      

Dim conegraphic As Graphic
Set conegraphic = ActiveDrawing.Graphics.GraphicFromID(coneID)

Dim planegraphic As Graphic
Set planegraphic = ActiveDrawing.Graphics.GraphicFromID(PlaneID)
      

Dim slither As Graphic
Dim Slice As New Boolean3D
Set slither = Slice.Intersection(conegraphic, planegraphic)  '

ActiveDrawing.Graphics.AddGraphic slither

Dim slithercopy As Graphic
Set slithercopy = slither.Duplicate

slithercopy.MoveRelative 150, 0, 0
'conegraphic.Delete
'planegraphic.Delete


End Sub






Private Function drawplane(centroid As Ty3Dpoint, ThetaXX As Double, ThetaYY As Double, sidelength As Double, thick As Double) As Long


    Dim Gr As Graphic
    Dim Gr1 As Graphic
    Dim Ver As Vertex
   
    
    Set Gr = ActiveDrawing.Graphics.Add(, "TCW40EXTRUDE")
     
    Set Gr1 = ActiveDrawing.Graphics.AddLineRectangle(-sidelength * 0.5, 0, 0, sidelength * 0.5, thick, 0)
    Set Gr1 = ActiveDrawing.Graphics.Remove(Gr1.Index)
    Gr.Graphics.AddGraphic Gr1
     
    Set Ver = Gr.Vertices.Add(0, 0, 0)
    Set Ver = Nothing

    Set Ver = Gr.Vertices.Add(0, 0, sidelength)
    Set Ver = Nothing
    
  Gr.MoveRelative 0, 0, -0.5 * sidelength - 0.5 * thick
  Gr.RotateAxis PI / 2, 100, 0, 0, -100, 0, 0
  
  Gr.RotateAxis ThetaXX, 100, 0, 0, -100, 0, 0
 
  Gr.RotateAxis ThetaYY, 0, 100, 0, 0, -100, 0
   
  Gr.MoveRelative centroid.x, centroid.y, centroid.z
  
  drawplane = Gr.ID

    Set Gr1 = Nothing
    Set Gr = Nothing

End Function













Private Function drawcone(BaseDia As Double, height As Double) As Long

Dim gloft As Graphic
Dim cone As Graphic

Set gloft = ActiveDrawing.Graphics.Add(, "TCW40LOFT")
    gloft.Properties("SOLID") = 1

Set cone = ActiveDrawing.Graphics.AddCircleCenterAndPoint(0, 0, 0, BaseDia * 0.5, 0, 0)

Set cone = ActiveDrawing.Graphics.Remove(cone.Index)
gloft.Graphics.AddGraphic cone

Set cone = ActiveDrawing.Graphics.AddCircleCenterAndPoint(0, 0, height, 0.00001, 0, height)
Set cone = ActiveDrawing.Graphics.Remove(cone.Index)
gloft.Graphics.AddGraphic cone


Dim coneup As Graphic
Set coneup = gloft.Duplicate
coneup.RotateAxis -PI, 0, height - 0.1, 0, 0, -100, height - 0.1


Dim doublecone As Graphic
Dim join As New Boolean3D
Set doublecone = join.Add(gloft, coneup)  '

ActiveDrawing.Graphics.AddGraphic doublecone

coneup.Delete
gloft.Delete


drawcone = doublecone.ID

Set gloft = Nothing



End Function