# Displaying Dandelin spheres touching hyperbola boundary patches in cone

Can we show the Dandelin spheres scenario (shown by user Hrhm for case of ellipse) for a hyperbola as well? I'm not happy with what we get to see of this on the net.

The double nappe/sheet of a cone is cut by a plane inclined at angle $$\beta < 2 \alpha$$ ( cutting plane inclination to a generator of cone, cone vertex angle ) cutting both nappes with hyperbolas as intersecting arcs.

The Dandelin spheres are placed in each cone tangentially, foci outside directrix planes The cutting plane contacts spheres at foci so that focal distance difference from hyperbola is constant.

I can also do this using ContourPlot3D, however you can make it with a great image quality.

Proper choice of $$\alpha, \beta$$ so that the difference of line segments can be convincingly visualized.

EDIT 1:

Some changes from the following need to be made to see points of tangential contact and radius vectors in the plane at an arbitrary point on hyperbola.

{s1=5,s2=3,H=-1,al=.8,bt=-2,Z=11.5,PltLim=5.1};
snal=(s1+s2)/Z;al=ArcSin[snal];tnal=Tan[al];
S1=ContourPlot3D[x^2+y^2+(z+s1/snal)^2==s1^2,{x,-PltLim,PltLim},{y,-PltLim,PltLim},{z,-PltLim,PltLim}];
S2=ContourPlot3D[x^2+y^2+(z-s2/snal)^2==s2^2,{x,-PltLim,PltLim},{y,-PltLim,PltLim},{z,-PltLim,PltLim}];
Keg=ContourPlot3D[x^2+y^2 -z^2 tnal^2==0,{x,-PltLim,PltLim},{y,-PltLim,PltLim},{z,-PltLim,PltLim},ContourStyle-> Opacity[.35]];
Plne=ContourPlot3D[ z  ==-x Tan[bt]+ H,{x,-PltLim,PltLim},{y,-PltLim,PltLim},{z,-PltLim,PltLim},ContourStyle-> Opacity[.9]];
Show[{S1,S2,Keg,Plne},PlotRange->All, Boxed->False,Axes->None] • Since you can do this with ContourPlot, please include the code and its output. I have a hard time following your description. Jun 21 '16 at 18:24
• Above is a start putting them together. Jun 22 '16 at 17:14

Here's a starting point. Figuring out what I exactly did is left as an exercise.

With[{r = 5/2, φ = π/4, s1 = 3/4, s2 = 3/2},
Graphics3D[{{Directive[CapForm[None], Opacity[2/3]],
Tube[{{0, 0, -r Cot[φ/2]}, {0, 0, 0}, {0, 0, r Cot[φ/2]}}, {r, 0, r}]},
{Sphere[{0, 0, s1 Csc[φ/2]}, s1], Sphere[{0, 0, -s2 Csc[φ/2]}, s2]},
{Directive[EdgeForm[], Opacity[1/2, LightBlue]],
InfinitePlane[#1, {#2 - #1, {0, 1, 0}}] &[
{s1/(s1 + s2) Sqrt[(s1 + s2)^2 - (s1 - s2)^2 Sin[φ/2]^2], 0,
s1 Csc[φ/2] - s1 (s1 - s2) Sin[φ/2]/(s1 + s2)},
{s2/(s1 + s2) Sqrt[(s1 + s2)^2 - (s1 - s2)^2 Sin[φ/2]^2], 0,
s2 (s2 - s1) Sin[φ/2]/(s1 + s2) - s2 Csc[φ/2]}]}},
Boxed -> False]] • Here are the corresponding pictures for the other conics: ellipse, parabola. The old code by Stan Wagon was rather long, but thanks to primitives like Cone[], Sphere[], and InfinitePlane[] being built-in, things are now easier to do. Jun 22 '16 at 6:27
• We need to show (with a small disk or tiny sphere) points of 1) tangential contact , 2) arbitrary point on hyperbola , 3) parallel circle points joined at any arbitrary point so that the difference of segment lengths is seen constant for hyperbola. Jun 23 '16 at 15:49
• As noted, this is only a starting point. If you'll read the code carefully, you will see that I've already found the tangency points for you. The others should not be too hard to add, if you're sufficiently inclined. Jun 23 '16 at 16:16
• OK, I'll take this hint. Jun 24 '16 at 17:17

Why not go to the WRI demo site and search for demos involving the Dandelin spheres? You can download the source code and see how some others did it.

• I believe the OP wanted the "hyperbolic" case of the Dandelin spheres, unlike the "elliptic case" featured in your book and the demonstration you linked to. (But he certainly can adapt the constructions in those to this one.) Jun 22 '16 at 14:02
• @stan wagon Pleasure going through many interesting Mathematica coded geometrical realizations in your book. May be you would also include hyperbola intersection made by plane touching Dandilion spheres in next edition. Jun 22 '16 at 19:13