Note

This Mathematica notebook is from the WWW project A Visual Dictionary of Special Plane Curves. Copyright © 1995-2000 by Xah Lee. (http://xahlee.org/)

Packages and Initializations

Needs["RuledSurfacePlot`"]
(*MathSource Item:0207-975*)

Needs["ExtendGraphics`Geometry3D`"]
(* MathSource Item:0208-976 *)

Needs["Graphics`Shapes`"]	(* 0200-608 *)

Needs["ParaPlot`"]
(*MathSource Item:0207-986*)

Define some convenient functions and set options

Define some convenient functions.

Clear[ Slice3DGraphics]

(*Clip3D is a function in Tom W.J.'s Package*)
(*It is not well documented. Here's a replacement usage documentation*)
Clip3D::usage= "Clip3D[ gPrim, Plane[p,v] ]
	will take a list of Graphics3D primitives gPrim, and return a list of
	Graphics3D primitives that is on one side of the plane Plane[p,v],
	where v is the normal vector and p is a point on the plane. Primitives
	that contain points on both sides are cut. Example:
	Needs[\"Graphics`Shapes`\"];
	Show@ Graphics3D@ Clip3D[ Torus[2,1,15,15], Plane[{2,0,0}, {-1,0,0}]]";

Slice3DGraphics::usage = "
	Slice3DGraphics[ graphics3DPrimitives,  sliceAxis, {p1, p2,...,pn} ]
	will return a list of Graphics3D primitives that is parts of the
	given graphics3DPrimitives sliced along planes passing through
	a list of nPoints {p1, p2,...,pn} and normal to sliceAxis vector.
	Graphics that lies outside the first and last cutting plane will
	be clipped.	The number of Graphics3D objects returned depends on
	positions of nPoints.
	The nPoints that define the slicing plane must be
	in order; towards the direction of sliceAxis vector.
	sliceAxis is a vector of the form {x,y,z}.
	Slice3DGraphics calls functions in the package ExtendGraphics`Geometry3D.";

Slice3DGraphics[ gp_List, axis_List, throughPoints_List ]:=
Module[{pieces, remain},
	remain = gp;
	pieces = Table[Null, {Length@ throughPoints-1} ];
	Do[
		remain = Clip3D[ remain, Plane[ throughPoints[[i]], axis] ];
		pieces[[i]] = Clip3D[ remain, Plane[ throughPoints[[i+1]], -axis] ],
		{i, Length@ pieces}
	];
	pieces
]

Clear[unitV, cT, cN, SpaceTube]

unitV[v_] := v/Sqrt[Plus@@(v^2)]

cT[curveF_] := 
	Module[{t, a},
		a = Derivative[1][curveF][t];
		a = {a[[2]],-First@a,0};
		Function @@ {t, Simplify@unitV[a]}
	];

cN[curveF_] := 
	Module[{t, a,a1,a2,a3},
		a = Derivative[1][curveF][t];
		{a1,a2,a3} = {First@a, a[[2]], Last@a};
		a = Simplify[{a1 a3, a2 a3, -a1^2-a2^2}];
		Function @@ {t, Simplify@unitV[a]}
	];

SpaceTube::usage= "SpaceTube[ {xf[#], yf[#], zf[#]}&, r] will return a
	pure function of
	the form Function[ {xf[#1,#2], yf[#1,#2], zf[#1,#2]}],
	that is a parametric representation of a tube of radius r in space 
	based on the space curve {xf[#], yf[#], zf[#]}&. For example\n
	SpaceTube[ {Cos[#], Sin[#], #}&, 1/2]
	";

SpaceTube[ curveF_, radius_ ] :=
	Module[{a, t, t2},
		a = 
		Identity[
			curveF[t] +
			cT[curveF][t] radius Cos[t2] +
			cN[curveF][t] radius Sin[t2] 
		];
		Function@@{{t,t2}, a}
 	]

This sets some default options for graphics.

SetOptions[ {Plot, ParametricPlot},
	PlotStyle->{Hue[.65], Hue[0], Hue[.35,1,.5]},
	AspectRatio->Automatic
];

SetOptions[ Graphics,
	Axes->True, AspectRatio->Automatic
];

SetOptions[ {Plot3D, ParametricPlot3D, Graphics3D},
	Axes->True,
	AxesLabel->{"x","y","z"},
	LightSources :>
	Table[
	{	{Random[],Random[],Random[]},
		Hue[Random[],Random[Real,{.5,1}], Random[Real,{.5,.9}] ]
	},
	{3}
	]
];

This notebook contain codes to generate illustration for a property of conic sections

Ellipse Seen as a Circle

Ellipse seen as a circle
An ellipse can be seen as a circle from centain view points. In other words, an ellipse will project into a circle at certain projection point.

The set of all such points is a hyperbola, shaped and positioned so that its vertexes is located at the ellipse's foci, and foci is on the ellipse's vertexes, and the plane it resides is orthogonal to the ellipse's.
See illustration below.

Try change the value for a, c, and viewParameter.
a is the distance from the ellipse' focus to center.
c is the distance from the ellipse' vertex to center. a <= c.
viewParameter is a value between .7 and 1.3. It determines the distance from the view point to the ellipse.

Clear[a,c,viewParameter,ellipseF, hyperbolaF,
ellipseGP, hyperbolaGP1,hyperbolaGP2,
distance, f1,f2,v1,v2, v0, p, q, m, w, alpha, theta, d];

a = .7; (* try a = .3, .7, .9 *)
c = 1;
viewParameter = .9; (* best between .7 and 1.3 *)

(* 6 seconds *)
ellipseF = SpaceTube[{ c Cos[#], Sqrt[c^2-a^2] Sin[#], 0}&, c/17.][u,v];
hyperbolaF = SpaceTube[{ a Sec[#], 0, Sqrt[c^2-a^2] Tan[#]}&, c/17.][u,v];

ellipseGP = First@ ParametricPlot3D[
	Evaluate@ ellipseF,
	{u,0, 2 Pi},{v,0, 2 Pi},
	PlotPoints->{30,5}, DisplayFunction->Identity
];

hyperbolaGP1 = First@ ParametricPlot3D[
	Evaluate@ hyperbolaF,
	{u, -Pi/2 +.5, Pi/2 -.4}, {v, 0, 2 Pi},
	PlotPoints->{25,5}, DisplayFunction->Identity
];

hyperbolaGP2 = First@ ParametricPlot3D[
	Evaluate@ hyperbolaF,
	{u, Pi/2 +.5, 2 Pi 3/4 -.4}, {v,0, 2 Pi},
	PlotPoints->{25,5}, DisplayFunction->Identity
];

Show[
	Graphics3D[{
		ellipseGP, hyperbolaGP1, hyperbolaGP2
	}],
	PlotRange->All
];

(* 15 seconds *)

(* Documentation for these codes *)
(*
Suppose the cutting plane is the x-y plane.
The ellipse lies in this plane with center at {0,0,0}
and focus lie on the x-axis.
The vertex of the cone is in the x-z plane and above the x-y plane.

	a is the distance from the ellipse' focus to center.
	c is the distance from the ellipse' vertex to center. a <= c.
	f1 and f2 are the focus of the ellipse, f1 = {a,0,0}, f2 = {-a,0,0}.
	v1 and v2 are the vertexes of the ellipse, v1 = {c,0,0}, v2 = {-c,0,0}.
	v0 is the vertex of the cone.
	alpha is the angle between the axis of the cone and its elements.
	theta is the smaller angle formed by the axis of the cone
	and the cutting plane.
	d is the distance from the vertex of the cone {0,0,0}
	to the cutting plane.

Given alpha, theta, and d, a unique conic section is defined.
It's eccentricity is Cos[theta]/Cos[alpha].
*)

distance[v1_,v2_] := With[{v = v1-v2}, Sqrt[v.v]];

{f1,f2} = { {a,0}, {-a,0}};
{v1,v2} = { {c,0}, {-c,0}};
v0 = { a Sec[#], Sqrt[c^2-a^2] Tan[#]}& [viewParameter];
p = unitV[v2 - v0] distance[v1,v0] + v0;
q = unitV[(v1-v0)] distance[v0,v2] + v0;
m = (p + v1)/2;
n = (q + v2)/2;
w = {-First[m-v0] Last@v0/Last[m-v0] + First@ v0, 0};

theta = With[{ v1 = v0 -m, v2 = {c,0}},
	ArcCos[ v1.v2 / (Sqrt[v1.v1] Sqrt[v2.v2])
	]
];

coneGP = First@ RuledSurfacePlot[
	{	{First@ v0, 0, Last@ v0},
		RotateSpaceCurve[ c {Cos@#, Sin@#, 0}+ {c,0,0}&, 0,-(Pi/2-theta),0
		][t]-{c,0,0}
	},
	{t,0, 2 Pi},
	HiddenSurface->True,
	CheckerBoardPattern->False,
	DisplayFunction->Identity
];

{coneGP1, coneGP2} = Slice3DGraphics[ coneGP, {0,0,1}, 
	{{0,0,-10},{0,0,0}, {0,0,10}}
];

coneGP1 = FixedPoint[ DeleteCases[ #, List[], {-2}]&, coneGP1, 10];
coneGP2 = FixedPoint[ DeleteCases[ #, List[], {-2}]&, coneGP2, 10];

Show[
	Graphics3D[{
		EdgeForm[], coneGP1,
		First@ WireFrame[coneGP2]
	}]
];

Below is a middle cross secton of the cone. The red line is the side view of the given ellipe with vertexes at v1, v2 and focus at f1, f2.
v0 is the vertex of the cone.

Clear[a,c,viewParameter,
unitV, distance, f1,f2,v1,v2, v0, p, q, m, n, w, d, alpha, theta,
hyperb, textGP];

a = .7; c = 1; viewParameter = .9;

unitV[v_] := v/Sqrt[Plus@@(v^2)];
distance[v1_,v2_] := With[{v = v1-v2}, Sqrt[v.v]];

{f1,f2} = { {a,0}, {-a,0}};
{v1,v2} = { {c,0}, {-c,0}};
v0 = { a Sec[#], Sqrt[c^2-a^2] Tan[#]}& [viewParameter];
p = unitV[v2 - v0] distance[v1,v0] + v0;
q = unitV[(v1-v0)] distance[v0,v2] + v0;
m = (p + v1)/2;
n = (q + v2)/2;
w = {-First[m-v0] Last@v0/Last[m-v0] + First@ v0, 0};
d = Last@ v0;

theta = With[{ v1 = v0 -m, v2 = {c,0}},
	ArcCos[ v1.v2 / (Sqrt[v1.v1] Sqrt[v2.v2])
	]
];

hyperb = First@ ParametricPlot[
	{ a Sec[t], Sqrt[c^2-a^2] Tan[t]},
	{t, 0.01, Pi/2, 3/2 Pi, 6.28}, PlotStyle->{Hue[.35,1,.5]},
	DisplayFunction->Identity
];

textGP = {	Hue[.05,1,.3],
			{Text["v0", v0, {1,-1}]},
			{Text["v1", v1, {1,-1}]},
			{Text["v2", v2, {1,-1}]},
			{Text["f1", f1, {1,-1}]},
			{Text["f2", f2, {1,-1}]},
			{Text["p", p, {1,-1}]},
			{Text["q", q, {1,-1}]},
			{Text["w", w, {1,-1}]}
		};

Show[
	Graphics[{
		hyperb,
		{Hue[0], Thickness[.01], Line[{v2,v1}]},
		{	Line[{ (q-v0) 1.2 + v0, v0, (v2-v0) 1.3 + v0}],
			Line[{v0, n}],
			Line[{v2,q}],
			Line[{v1,p}]
		},
		{Hue[.65], PointSize[.02], Point /@ {v0,v1,v2,f1,f2, p,q,w}},
		{textGP}
	}],
	AxesLabel->{"x","z"},
	Ticks->None,
	AspectRatio->Automatic,
	PlotRange->
	({{Min@ First@ #, Max@ First@ #},{Min@ Last@ #, Max@ Last@ #}}& @
	Transpose@ {v0,v1,v2,p,q}) 1.5
];

v0, v1, and v2 together forms the cone.
v0 is the projection point, or eye position, looking towards w.
v1, p and v2, q forms the circle we perceive.

We see that as v0 moves on the hyperbola, different cones are generated but the plane v1, v2 will always cut the cone to form the same ellipse. This tells us the relationship of how different cones can generate the same ellipse.
Here is an animation that shows this.

Clear[a,c,
unitV, distance, f1,f2,v1,v2, hyperb, v0, p, q, m,n, w];

a = .7; c = 1;

unitV[v_] := v/Sqrt[Plus@@(v^2)]
distance[v1_,v2_] := With[{v = v1-v2}, Sqrt[v.v]];

{f1,f2} = { {a,0}, {-a,0}};
{v1,v2} = { {c,0}, {-c,0}};

hyperb = First@ ParametricPlot[
	{ a Sec[t], Sqrt[c^2-a^2] Tan[t]},
	{t, 0.01, Pi/2, 3/2 Pi, 6.28}, PlotStyle->{Hue[.35,1,.5]},
	DisplayFunction->Identity
];
	
Do[
v0 = { a Sec[#], Sqrt[c^2-a^2] Tan[#]}& [i];
p = unitV[v2 - v0] distance[v1,v0] + v0;
q = unitV[(v1-v0)] distance[v0,v2] + v0;
m = (p + v1)/2;
n = (q + v2)/2;
w = {-First[m-v0] Last@v0/Last[m-v0] + First@ v0, 0};
Show[
	Graphics[{
		hyperb,
		{Hue[0], Thickness[.01], Line[{v2,v1}]},
		{	Line[{ (q-v0) 1.2 + v0, v0, (v2-v0) 1.3 + v0}],
			Line[{v0, n}],
			Line[{v2,q}],
			Line[{v1,p}]
		},
		{Hue[.65], PointSize[.02], Point /@ {v0,v1,v2,f1,f2, p,q,w}}
	}],
	AxesLabel->{"x","z"},
	Ticks->None,
	AspectRatio->Automatic,
	PlotRange->{{-1,1},{-1,1}} 2
],
{i, .5, 1.18, (1.18-.5)/12}
]