ConicSection0=Module[{A,B,Z,AA,R,ph,scale,epsilon,epsilonmax,vshift,vshiftmax,Xmin,Xmax,Ymin,Ymax,Zmin,Zmax,theta,phi,Z1,Z2,R1,R2,Cone1,Cone2,CS,CSaxis,IP,C1,C2,C1S,C2S,S1,S2,F1,F2,F1S,F2S,Ring0,Ring1,Ring2,Apex,ApexS,P0,P1,P2,P3,P0S,P1S,P2S,P3S,T1A,T1B,T2A,T2B,L0,L1,L2,L3,HP0,HP1,HP2,PlotSpheres,PlotSphereCenters,PlotFocalPoints,PlotRings,PC,PP,PS,PT1,PT2,PH,AZ,x,y,Figure},
Manipulate[
A=Pi AA/2;
R=Tan[A];
If[ph<-2/R,ph=-2/R];
scale=-ph;
epsilonmax=IntegerPart[20.Sqrt[1+R^2]]/20.;
vshiftmax=4(1/R-1);
If[epsilon>epsilonmax,epsilon=epsilonmax];
If[vshift>vshiftmax,vshift=vshiftmax];
Xmin=-2;
Xmax=2;
Ymin=-2;
Ymax=2;
Zmin=-2/R+vshift;
Zmax=-2/R+4+vshift;
theta=ArcSin[epsilon/Sqrt[1+R^2]];
If[epsilon==1,
{Z1=scale/2;Z2=0},
{Z1=scale Cos[theta]/(Cos[theta]+Sin[A]);Z2=scale Cos[theta]/(Cos[theta]-Sin[A])}
];
R1=Z1 Sin[A];
R2=Z2 Sin[A];
Cone1=Cone[{{0,0,-2/R},{0,0,0}},2];
Cone2=Cone[{{0,0,2/R},{0,0,0}},2];
If[epsilon==1,
CS=ParametricPlot3D[{scale R Sin[phi]/(1+Cos[phi]),scale R Cos[phi]/(1+Cos[phi]),-scale/(1+Cos[phi])},{phi,-Pi+0.01,Pi-0.01},Exclusions->{1+R Tan[theta] Cos[phi]==0,"Discontinuities"},ExclusionsStyle->{Red},PlotStyle->{Thickness[0.005],Black,Opacity[1]}],
CS=ParametricPlot3D[{scale R Sin[phi]/(1+R Tan[theta]Cos[phi]),scale R Cos[phi]/(1+R Tan[theta]Cos[phi]),-scale/(1+R Tan[theta]Cos[phi])},{phi,-Pi,Pi},Exclusions->{1+R Tan[theta] Cos[phi]==0,"Discontinuities"},ExclusionsStyle->{Red},PlotStyle->{Thickness[0.005],Black,Opacity[1]}]
];
IP=Graphics3D[{Opacity[0.2],Green,InfinitePlane[{0,0,-scale},{{1,0,0},{0,Cos[theta],Sin[theta]}}]}];
CSaxis=ParametricPlot3D[{0,y,y Tan[theta]-scale},{y,-2,2},PlotStyle->{Opacity[1],Thickness[0.002],Green}];
C1={0,0,-Z1};
C2={0,0,-Z2};
S1=Sphere[C1,R1];
S2=Sphere[C2,R2];
C1S=Sphere[C1,0.03];
C2S=Sphere[C2,0.03];
PlotSpheres=If[epsilon==1,
Graphics3D[{Opacity[0.3],Red,{S1}}],
Graphics3D[{Opacity[0.3],Red,{S1,S2}}]
];
PlotSphereCenters=If[epsilon==1,
Graphics3D[{Opacity[1],Red,{C1S}}],
Graphics3D[{Opacity[1],Red,{C1S,C2S}}]
];
F1={0,R1 Sin[theta],-Z1-R1 Cos[theta]};
F2={0,-R2 Sin[theta],-Z2+R2 Cos[theta]};
F1S=Sphere[F1,0.03];
F2S=Sphere[F2,0.03];
PlotFocalPoints=If[epsilon==1,
Graphics3D[{Opacity[1],Cyan,{F1S}}],
Graphics3D[{Opacity[1],Cyan,{F1S,F2S}}]
];
Ring0=ParametricPlot3D[{scale R Sin[phi]/(1+R Tan[theta]Cos[AZ]),scale R Cos[phi]/(1+R Tan[theta]Cos[AZ]),-scale/(1+R Tan[theta]Cos[AZ])},{phi,0,2Pi},PlotStyle->{Opacity[0.5],Blue}];
Ring1=ParametricPlot3D[{R1 Cos[A]Sin[phi],R1 Cos[A]Cos[phi],-Z1 Cos[A]^2},{phi,0,2Pi},PlotStyle->{Opacity[0.5],Blue}];
Ring2=ParametricPlot3D[{R2 Cos[A]Sin[phi],R2 Cos[A]Cos[phi],-Z2 Cos[A]^2},{phi,0,2Pi},PlotStyle->{Opacity[0.5],Blue}];
PlotRings=If[epsilon==1,
{Ring1},
{Ring1,Ring2}
];
Apex={0,0,0};
ApexS=Sphere[Apex,0.03];
P0={-scale R Sin[AZ]/(1+R Tan[theta]Cos[AZ]),scale R Cos[AZ]/(1+R Tan[theta]Cos[AZ]),-scale/(1+R Tan[theta]Cos[AZ])};
P1={-R1 Cos[A]Sin[AZ],R1 Cos[A]Cos[AZ],-Z1 Cos[A]^2};
P2={-R2 Cos[A]Sin[AZ],R2 Cos[A]Cos[AZ],-Z2 Cos[A]^2};
P3={-scale R Sin[AZ]/(1+R Tan[theta]Cos[AZ]),scale(1+ Sin[A]^2)R/2,-scale Cos[A]^2/2};
P0S=Sphere[P0,0.03];
P1S=Sphere[P1,0.03];
P2S=Sphere[P2,0.03];
P3S=Sphere[P3,0.03];
T1A=Triangle[{C1,P0,F1}];
T1B=Triangle[{C1,P0,P1}];
T2A=Triangle[{C2,P0,F2}];
T2B=Triangle[{C2,P0,P2}];
L0=Line[{Apex,P0}];
L1=Line[{Apex,P1}];
L2=Line[{Apex,P2}];
L3=Line[{P0,P3}];
HP0=Graphics3D[{Opacity[0.2],Orange,InfinitePlane[{0,0,-scale/(1+R Tan[theta]Cos[AZ])},{{1,0,0},{0,1,0}}]}];
HP1=Graphics3D[{Opacity[0.2],Orange,InfinitePlane[{0,0,-Z1 Cos[A]^2},{{1,0,0},{0,1,0}}]}];
HP2=Graphics3D[{Opacity[0.2],Orange,InfinitePlane[{0,0,-Z2 Cos[A]^2},{{1,0,0},{0,1,0}}]}];
If[PC==False,PP=False];
If[epsilon==1,PT2=False];
Figure={Graphics3D[{Opacity[0.2],Blue,Lighting->Automatic,{Cone1,Cone2}}]};
If[PC, AppendTo[Figure,{CS}]];
If[PP, AppendTo[Figure,{IP,CSaxis}]];
If[PS, AppendTo[Figure,{PlotSpheres}]];
If[PS||PT1||PT2,AppendTo[Figure,{PlotSphereCenters,PlotFocalPoints,PlotRings}]];
If[PT1||PT2,{
AppendTo[Figure,
{Ring0,
Graphics3D[{Opacity[1],Blue,{ApexS,P0S}}],
Graphics3D[{Opacity[1],Black,{L0}}]}
],
If[PH && !epsilon==0,AppendTo[Figure,{HP0}]]
}
];
If[PT1 ,
AppendTo[Figure,
{Graphics3D[{Opacity[1],Blue,{P1S}}],
Graphics3D[{EdgeForm[Directive[Thick]],Opacity[0.3],Yellow,{T1A,T1B}}],
Graphics3D[{Opacity[1],Thick,Black,{L1}}]
}]
];
If[PT2,
AppendTo[Figure,
{Graphics3D[{Opacity[1],Blue,{ApexS,P0S,P2S}}],
Graphics3D[{EdgeForm[Directive[Thick]],Opacity[0.3],Yellow,{T2A,T2B}}],
Graphics3D[{Opacity[1],Thick,Black,{L2}}]}]
];
If[PH,
If[epsilon==1,
AppendTo[Figure,{HP1}],
AppendTo[Figure,{HP1,HP2}]
]
];
If[PP && PH&& !epsilon==0,
{If[PT1||PT2,
{AppendTo[Figure,
{ParametricPlot3D[{x,scale R Cos[AZ]/(1+R Tan[theta]Cos[AZ]),-scale/(1+R Tan[theta]Cos[AZ])},{x,-2,2},PlotStyle->{Orange}]}],
If[epsilon==1,
AppendTo[Figure,
{Graphics3D[{Opacity[1],Blue,{P3S}}],
Graphics3D[{Opacity[1],Thick,Black,{L3}}]}]
]}
];
If[epsilon==1,
AppendTo[Figure,
{ParametricPlot3D[{x,(-Z1 Cos[A]^2+scale)/Tan[theta],-Z1 Cos[A]^2},{x,-2,2},PlotStyle->{Orange}]}],
AppendTo[Figure,
{ParametricPlot3D[{x,(-Z1 Cos[A]^2+scale)/Tan[theta],-Z1 Cos[A]^2},{x,-2,2},PlotStyle->{Orange}],
ParametricPlot3D[{x,(-Z2 Cos[A]^2+scale)/Tan[theta],-Z2 Cos[A]^2},{x,-2,2},PlotStyle->{Orange}]}]
]
}
];
Show[Figure,
PlotRange->{{Xmin,Xmax},{Ymin,Ymax},{Zmin,Zmax}},ViewPoint->{5 Cos[B],-5 Sin[B],Z},ImageSize->Large,SphericalRegion->True
],
{{AA,0.5,"Apex Angle/π"},2ArcTan[0.5]/Pi,0.5,Appearance->"Labeled"},
{{ph,-1,"Section Plane Height"},-2/Tan[Pi AA/2],-1},
{{epsilon,0,"Eccenticity ϵ"},0,IntegerPart[20.Sqrt[1+Tan[Pi AA/2]^2]]/20.,0.05,Appearance->"Labeled"},
{{AZ,0,"Rotate Point"},-Pi+0.01,Pi-0.01},
{{B,0,"Rotate Figure"},-Pi,Pi},
{{Z,0,"Viewpoint Height"},-5,5,0.5},
{{vshift,0,"Vertical Shift"},0,4/Tan[Pi AA/2]-4},
{{PC,False,"Conic Section"},{True,False}},
{{PP,False,"Section Plane"},{True,False}},
{{PS,False,"Inscribed Spheres"},{True,False}},
{{PT1,False,"Congruent Triangles Set 1"},{True,False}},
{{PT2,False,"Congruent Triangles Set 2"},{True,False}},
{{PH,False,"Horizontal Planes"},{True,False}},
ControlPlacement->Right,
LabelStyle->{Directive[12],FontFamily->"Ariel"},
ContinuousAction->True
]
]

Export["ConicSection0.cdf",ConicSection0,"CDF"]