Conic sections: intersection of a plane and a cone. How can I change the equation of the plane to get conic sections automatically?

Question

I tried to draw intersection of a plane and a cone.

Hyperbola

Clear["Global`*"]
myh = 5;
myr = 4;
pA = {0, 0, myh};
pT = {0, 0, 2*myh};
pO = {0, 0, 0};
cone1 = Cone[{pO, pA}, myr];
cone2 = Cone[{pT, pA}, myr];
plane = InfinitePlane[{{0, -3, 0}, {1, 2, 3}, {2, 3, 2}}];
plotcone1 = 
  RegionPlot3D[DiscretizeRegion@RegionIntersection[cone1, plane], 
   BoundaryStyle -> {Thick, Red}, PlotStyle -> None, Boxed -> False, 
   PlotRange -> All];
plotcone2 = 
  RegionPlot3D[DiscretizeRegion@RegionIntersection[cone2, plane], 
   BoundaryStyle -> {Thick, Red}, PlotStyle -> None, Boxed -> False, 
   PlotRange -> All];
Show[plotcone1, plotcone2, 
 Graphics3D[{Opacity[0.8], cone1, cone2, plane}, Boxed -> False]]

Parabola

Clear["Global`*"]
myh = 5;
myr = 4;
pA = {0, 0, myh};
pT = {0, 0, 2*myh};
pO = {0, 0, 0};
cone1 = Cone[{pO, pA}, myr];
cone2 = Cone[{pT, pA}, myr];
plane = InfinitePlane[{{0, 2, 0}, {1, 2, -1}, {2, 2, 0}}];
plotcone1 = 
  RegionPlot3D[DiscretizeRegion@RegionIntersection[cone1, plane], 
   BoundaryStyle -> {Thick, Red}, PlotStyle -> None, Boxed -> False, 
   PlotRange -> All];
plotcone2 = 
  RegionPlot3D[DiscretizeRegion@RegionIntersection[cone2, plane], 
   BoundaryStyle -> {Thick, Red}, PlotStyle -> None, Boxed -> False, 
   PlotRange -> All];
Show[plotcone1, plotcone2, 
 Graphics3D[{Opacity[0.8], cone1, cone2, plane}, Boxed -> False]]

 

I input the plane = InfinitePlane[{{0, -3, 0}, {1, 2, 3}, {2, 3, 2}}]; by hand. How can I input InfinitePlane to get conic sections automatically? Can I input InfinitePlane in the form a x + b y + c z + d = 0?

Answer 1

• For any plane equation {a,b,c}.{x,y,z}=d, we use MeshFunction->Function[{x, y, z}, {a, b, c} . {x, y, z} - d and Hyperplane[{a,b,c},d].

Clear["Global`*"]
myh = 5;
myr = 4;
pA = {0, 0, myh};
pT = {0, 0, 2*myh};
pO = {0, 0, 0};
cone1 = Cone[{pO, pA}, myr];
cone2 = Cone[{pT, pA}, myr];
{a, b, c} = RandomPoint[Sphere[]];
d = RandomReal[];
plot3d = 
  RegionPlot3D[{cone1, cone2}, 
   MeshFunctions -> Function[{x, y, z}, {a, b, c} . {x, y, z}], 
   Mesh -> {{d}}, MeshStyle -> Directive@{Thick, Red}];
plane = Graphics3D[Hyperplane[{a, b, c}, d]];
Show[plot3d, plane]

• Manipulate

Manipulate[
 Module[{plot3d, plane}, 
  mesh = RegionPlot3D[{cone1, cone2}, 
    MeshFunctions -> Function[{x, y, z}, {a, b, c} . {x, y, z}], 
    Mesh -> {{d}}, MeshStyle -> Directive@{Thick, Red}, 
    PlotStyle -> Transparent];
  g3d = Graphics3D[{cone1, cone2, Hyperplane[{a, b, c}, d]}];
  Show[g3d, mesh, 
   PlotRange -> {Automatic, Automatic, {0, 10}}]], {a, -1, 1}, {b, -1,
   1}, {c, -1, 1}, {d, -1, 1}]

Answer 2

EDIT: I've rewritten pre-existing code significantly in addition to ImplicitRegion tricks below.

First of all using RegionPlot3D with discretized regions works... mostly by sheer luck. It's not really designed for that.

My personal approach to this is to discretize the intersection of the boundary of the cone with the plane, extract Line components from it... and show all this as plain Graphics3D content.

The problem you ran into while attempting to show intersection which intersects with only one of the two cones is, if you ask me, both a bug and a design issue in Mathematica: it can't really discretize an empty region since it can't express an $n$-dimensional empty mesh region! So, my workaround checks if the region to be discretized is actually empty, and instead of discretizing it if this is the case, just adds Nothing (that is, no entry) to the list of Graphics3D primitives.

---

I don't really know what you mean by "how can I input InfinitePlane to get conic sections automatically" but below is a solution to your second question.

You can use ImplicitRegion. The issue here is, though, that ImplicitRegion isn't a graphics primitive.

First of all, an ImplicitRegion can be generated using RegionConvert:

RegionConvert[InfinitePlane[{{0, -3, 0}, {1, 2, 3}, {2, 3, 2}}], "Implicit"]

(* ImplicitRegion[
    2 \[FormalX] + \[FormalZ] == 3 + \[FormalY], {\[FormalX], \[FormalY], \[FormalZ]}] *)

If you want to convert this implicit region back to an InfinitePlane, you have another problem. We can pick three points from the plane and reconstruct it from them, but RandomPoint doesn't work because you can't really take a uniform sample from an infinite plane. We can use FindInstance, though.

The code below represents the implicit plane equation as iplane, and derives the graphics primitive plane from it:

Clear["Global`*"]
myh = 5;
myr = 4;
pA = {0, 0, myh};
pT = {0, 0, 2 myh};
pO = {0, 0, 0};
cone1 = Cone[{pO, pA}, myr];
cone2 = Cone[{pT, pA}, myr];
iplane = ImplicitRegion[2 x - y + z - 3 == 0, {x, y, z}];
plane = InfinitePlane[{x, y, z} /. 
    FindInstance[RegionMember[iplane, {x, y, z}], {x, y, z}, 3]];
Graphics3D[{{Red, Thick, 
   With[{r = RegionIntersection[RegionBoundary[#], iplane]}, 
      If[RegionEqual[r, EmptyRegion[3]], Nothing, 
       MeshPrimitives[DiscretizeRegion[r, Method -> "Semialgebraic"], 
        1]]] & /@ {cone1, cone2}}, {Opacity[0.8], cone1, cone2, 
   plane}}, Boxed -> False]