Wolfram Cloud Document

DandelineSpheres-Ellipse::usage="Spheres tangent to a plane and a cone, their points of contact with the plane determine the foci of the ellipse in the spaceformed by the intersection of the plane and the cone. References: Wolfram MathWorld, Dandeline Spheres; ResourceFunction: TangentPlane; Personal. ";

In[]:=

SwatchLegend[{DarkGreen,Red,Yellow,Black},{"Q-point, orbit of the major sphere","P-Point, orbit of the ellipse","T-point, orbit of minor sphere","The two focus"}]Manipulate[j[x_,y_]:=3.6363653076415887`+0.582101563372971`x;a1=0.582101563372971`;b1=0;c1=-1;d1=-3.6363653076415887`;γ[t_]:={(d1/(a1Cos[t]+b1Sin[t]+c1))Cos[t],(d1/(a1Cos[t]+b1Sin[t]+c1))Sin[t],d1/(a1Cos[t]+b1Sin[t]+c1)};ζ[t_]:={10Cos[t],10Sin[t],10};

[t_]:={Cos[t],Sin[t],1};d11[t_]:=N[Norm[-{-0.7115172569571225`,0,3.22219}+γ[t]]];d22[t_]:=N[Norm[-{7.113062312298661`,0,7.776893007857764`}+γ[t]]];d3[t_]:=d11[t]+d22[t];d4[t_]:=N[Norm[ζ[t]-γ[t]]];d5[t_]:=N[Norm[

[t]-γ[t]]];d6[t_]:=d4[t]+d5[t];d7[t_]:=N[Norm[-

[t]+ζ[t]]];w=Grid[{{

,2a},{d11[θ1],d22[θ1],d3[θ1]}},FrameAll,ItemSize->15,ItemStyle->15];o=Grid[{{

},{d4[θ1],d5[θ1],d6[θ1],d7[θ1]}},FrameAll,ItemSize->15,ItemStyle->15];Show[surf1=ParametricPlot3D[{vCos[u],vSin[u],v},{u,0,2π},{v,-20,20},PlotStyleDirective[Green,Specularity[White,20],Opacity[0.1]],MeshFalse,PerformanceGoal"Quality"],surf2=ParametricPlot3D[

Cos[u]Sin[v],

Sin[u]Sin[v],

Cos[v]+2,{u,0,2π},{v,0,π},ColorFunction"LightTemperatureMap",MeshFalse,PerformanceGoal"Quality"],surf3=ParametricPlot3D[10

Cos[u]Sin[v],10

Sin[u]Sin[v],10

Cos[v]+20,{u,0,2π},{v,0,π},ColorFunction"LightTemperatureMap",MeshFalse,PerformanceGoal"Quality"],surf4=Plot3D[j[x,y],{x,-10,10},{y,-10,10},PlotStyleDirective[Yellow,Opacity[0.1]],BoundaryStyleDirective[Black,Thick],MeshFalse,PerformanceGoal"Quality"],curv1=ParametricPlot3D[ζ[t],{t,0,2π},PerformanceGoal"Quality"],curv2=ParametricPlot3D[

[t],{t,0,2π},PerformanceGoal"Quality"],curv3=ParametricPlot3D[γ[θ],{θ,0,θ1},ColorFunction->"NeonColors",PerformanceGoal"Quality"],Graphics3D[{Black,Ball[{-0.7115172569571225`,0,3.22219},0.2]}],Graphics3D[{Black,Ball[{7.113062312298661`,0,7.776893007857764`},0.2]}],Graphics3D[{Red,Ball[N[γ[θ1]],0.2]}],Graphics3D[{DarkGreen,Ball[N[ζ[θ1]],0.2]}],Graphics3D[{Yellow,Ball[N[

[θ1]],0.2]}],Graphics3D[{Black,Dashed,Thick,Line[{N[γ[θ1]],{-0.7115172569571225`,0,3.22219}}]}],Graphics3D[{Black,Dashed,Thick,Line[{N[γ[θ1]],{7.113062312298661`,0,7.776893007857764`}}]}],Graphics3D[{Blue,Thick,InfiniteLine[{{0,0,0},γ[θ1]}]}],AxesLabel->(Style[#,15,Blue]&/@{"X","Y","Z"}),AxesOrigin{0,0,0},MeshFalse,AxesTrue,BoxedFalse,PlotRange{-10,35},ViewPoint{1.3,-2.4,0},ImageSizeFull,BoxRatiosAutomatic],Style["Dandelin Spheres - Ellipse:",Bold,Medium],{{θ1,1,"Angle (θ)"},0.01,2π,0.01},Delimiter,{{w,2,"Vector-radius of Ellipse"}},Delimiter,{{o,3,"Vector-radius of Spheres"}},ControlPlacementTop]

Out[]=

	Q-point, orbit of the major sphere
	P-Point, orbit of the ellipse
	T-point, orbit of minor sphere
	The two focus

Out[]=

Dandelin Spheres - Ellipse:

Angle (θ)

Vector-radius of Ellipse

PF 1	PF 2	2a
10.8916	1.8381	12.7297

Vector-radius of Spheres

QP	PT	PT + QP	QT
1.83637	10.8916	12.7279	12.7279