2
$\begingroup$

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

enter image description here

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

 

enter image description here

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?

$\endgroup$

2 Answers 2

4
$\begingroup$
  • 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}]

enter image description here

$\endgroup$
4
$\begingroup$

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]

enter image description here

$\endgroup$
5
  • $\begingroup$ I tried iplane = ImplicitRegion[x + z + y - 3 == 0, {x, y, z}]; or iplane = ImplicitRegion[x- 3 == 0, {x, y, z}]; I can not get result. $\endgroup$ Mar 27 at 7:35
  • $\begingroup$ I've modified my answer significantly, please check if it works for you (it does for me.) $\endgroup$
    – kirma
    Mar 27 at 9:40
  • $\begingroup$ Thanks. Sometimes, the plane cut only one cone. E,g. iplane = ImplicitRegion[ z - 3 == 0, {x, y, z}]; or iplane = ImplicitRegion[ 3 x + z - 3 == 0, {x, y, z}]; Please consider this cases. $\endgroup$ Mar 27 at 9:51
  • $\begingroup$ Sigh... the EmptyRegion test was supposed to fix this, but it seems your examples run into a kink that is discretizing single-dimensional regions in three dimensions. The situation can be improved with addition of Method -> "Semialgebraic" on DiscretizeRegion, which solves your second example. Sadly it doesn't solve the first one, but on basis of bug feedback I've received from WRI rather recently, "Semialgebraic" method has seen improvements and this is going to be fixed in a version not so far in the future. $\endgroup$
    – kirma
    Mar 27 at 10:13
  • 1
    $\begingroup$ Thank you very much. $\endgroup$ Mar 27 at 10:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.