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`"]

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

(*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}]]";

Clear[Slice3DGraphics];
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];

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

Conic Sections
Fancy Illustration

Desecription

This notebook contain codes to generate some artistic images of multiply sliced double cone.

Author: Xah Lee
Last Modified: 1999/02

coneGP = 
        First[RuledSurfacePlot[{{Cos[t], Sin[t], 1}, {Cos[t + π], 
                Sin[t + π], -1}}, {t, 0, 2 π}, 
            PlotPoints -> {25, 3}, CheckerBoardPattern -> False, 
            Axes -> False, 
            DisplayFunction -> Identity]];
wireFramedConeGP = (First[
                ParametricPlot3D[{#1 Cos[t], #1 Sin[t], #1}, {t, 0, 
                    2 π}, 
                  DisplayFunction -> 
                    Identity]] &) /@ {-1, - .6,  .6, 
            1};
coneGP = DeleteCases[coneGP, _Line | _Hue, -1];

hyperbola cut

(* 50 seconds on PowerMac 7500/100 *)
slicedConeGP = 
	Slice3DGraphics[ coneGP, {3,0,1},
		Table[{i,0,0}, {i,-2, .5, .13}]
	];

slicedConeGP = First@ Transpose@ Partition[ Reverse@ slicedConeGP, 2];

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

Show[
        Graphics3D[{EdgeForm[], slicedConeGP, 
            wireFramedConeGP}, {LightSources -> 
              Table[{{Random[], Random[], Random[]}, 
                  Hue[Random[], Random[Real, { .5, 1}], 
                    Random[Real, {0,  .9}]]}, {Random[Integer, {2, 3}]}], 
            Axes -> False, ViewPoint -> {0.988, -3.018, 1.168}, 
            Boxed -> False}]];

parabola cut

slicedConeGP = 
        Slice3DGraphics[coneGP, {1, 0, 1}, 
          Table[{i, 0, 0}, {i, -2, 1.1,  .15}]];
slicedConeGP = 
        First[Transpose[Partition[Reverse[slicedConeGP], 2]]];
slicedConeGP = 
        FixedPoint[DeleteCases[#1, {}, {-2}] &, slicedConeGP, 
          10];

Show[Graphics3D[{EdgeForm[], slicedConeGP, wireFramedConeGP}], 
        Axes -> False, ViewPoint -> {0.988, -3.018, 1.168}, 
        Boxed -> False];

ellipse cut

slicedConeGP = 
        Slice3DGraphics[coneGP, {1, 0, 2}, 
          Table[{i, 0, 0}, {i, -3, 1.2,  .16}]];
slicedConeGP = 
        First[Transpose[Partition[Reverse[slicedConeGP], 2]]];
slicedConeGP = 
        FixedPoint[DeleteCases[#1, {}, {-2}] &, slicedConeGP, 
          10];

Show[Graphics3D[{EdgeForm[], slicedConeGP, wireFramedConeGP}], 
        Axes -> False, ViewPoint -> {0.988, -3.018, 1.168}, 
        Boxed -> False];