2D cross-section of ParametricPlot3D

Question

Now I'm trying to get the two-dimensional cross-section from ParametricPlot3D, the details of this question are as follows

As an example, here is a parametric equation: x=x(u,v) y=y(u,v) z=z(u,v)

We can use ParametricPlot3D to plot the surface that it describes

    ParametricPlot3D[{1.16^v Cos[v] (1 + Cos[u]), -1.16^v Sin[v] (1 + Cos[u]), -2 1.16^v (1 + Sin[u])}, {u, 0, 2 Pi}, {v, -15, 6}, Mesh -> False, PlotRange -> All]

As you see, it is a 3D cube with a surface described by the equation, and the three directions of the cube represent the x, y and z axes

Now what I want is to generate the cross-section decided by z=constant, it is supposed be a curve in a 2D X-Y plane. So what I want is not a curve plotted in a cube, but a curve plotted on an X-Y plane, just like the picture below

how can I do that?

Here is another question similar to mine, but the answer below can not generate a 2D graph https://stackoverflow.com/questions/10423185/cross-section-mathematica

Thank you in advance!

Answer 1

We can use the MeshFunctions options and extract the slice data accordingly.

plot = ParametricPlot3D[{1.16^v Cos[v] (1 + Cos[u]), -1.16^v Sin[v] (1 + Cos[u]), -2 1.16^v (1 + Sin[u])}, 
  {u, 0, 2 Pi}, {v, -15, 6}, MeshFunctions -> {#3 &}, Mesh -> 100, PlotRange -> All, PlotPoints -> 100];

mr = DiscretizeGraphics[plot, _Line];

bds2d = Most[PlotRange[plot]];

zcuts3d = RegionUnion @@@ GatherBy[
  SortBy[ConnectedMeshComponents[mr], RegionBounds[#][[3]]&], RegionBounds[#][[3]]&];

zcuts = Map[
  RegionBounds[#][[3, 1]] -> MeshRegion[MeshCoordinates[#][[All, 1 ;; 2]], MeshCells[#, 1]]&,
  zcuts3d
];

Manipulate[
  Labeled[
    MeshRegion[#2, MeshCellStyle -> {0 -> None, 1 -> Black}, PlotRange -> bds2d], 
    Text[Style[z == #1, 24]]
  ] & @@ zcuts[[i]], 
  {i, 1, Length[zcuts], 1}
]

Answer 2

With z constant, the third term in your parametrized vector is equal to said constant and defines a relationship between the parameters u and v.

zValue == -2 1.16^v (1 + Sin[u])

We can use that relationship to get x/y coordinates that are defined by only one parameter.

With[{zValue = -2},
 rules = 
  Solve[zValue == -2 1.16^v (1 + Sin[u]) && 
    0 <= u <= 2 Pi && -15 <= v <= 6, v];
 ParametricPlot[{1.16^v Cos[v] (1 + Cos[u]), -1.16^v Sin[
      v] (1 + Cos[u])} /. rules, {u, 0, 2 Pi}, Mesh -> False, 
  PlotRange -> All, PlotPoints -> 50]]

Which we can compare to the cut 3D plot.

cuttingPlane = InfinitePlane[{{0, 0, -2}, {0, 1, -2}, {1, 0, -2}}];
ParametricPlot3D[{1.16^v Cos[v] (1 + Cos[u]), -1.16^v Sin[
    v] (1 + Cos[u]), -2 1.16^v (1 + Sin[u])}, {u, 0, 2 Pi}, {v, -15, 
  6}, Mesh -> False, PlotRange -> All, PlotPoints -> 50,
 ClipPlanes -> cuttingPlane, ViewPoint -> {0, 0, 2}]

Answer 3

Clear["Global`*"]

{fx, fy, fz} = {
   (29/25)^v Cos[v] (1 + Cos[u]),
   -(29/25)^v Sin[v] (1 + Cos[u]),
   -2 (29/25)^v (1 + Sin[u])};

The values of v for which z has a constant value of zc are given by

vValue[u_, zc_] = Solve[{fz == zc,
     0 <= u <= 2 Pi, -15 <= v <= 6}, v, Reals][[1]] //
  Simplify[#, {0 <= u <= 2 Pi, -15 <= v <= 6}] &

Manipulate[
 Row[{
   ParametricPlot3D[{fx, fy, fz},
    {u, 0, 2 Pi}, {v, -15, 6},
    Mesh -> False,
    PlotRange ->
     {{-3.3, 4.75}, {-2.7, 4.2}, {-10, 0}},
    PlotPoints -> 50,
    MaxRecursion -> 3,
    AxesLabel -> (Style[#, 14] & /@ {x, y, z}),
    ImageSize -> Small,
    RegionFunction -> (#3 < zc &)],
   ParametricPlot[
    Evaluate[Simplify[
      {fx, fy} /. vValue[u, zc]]],
    {u, 0, 2 Pi},
    Exclusions -> {u == 3 Pi/2},
    Mesh -> False,
    PlotRange -> {{-3.3, 4.75}, {-2.7, 4.2}},
    PlotPoints -> 100,
    MaxRecursion -> 5,
    AxesLabel -> (Style[#, 14] & /@ {x, y}),
    ImageSize -> Small,
    Exclusions -> {u == 3 Pi/2}]}],
 {{zc, -3}, -10, 0, 0.05, Appearance -> "Labeled"}]

Answer 4

We may set the z component to a given value and then solve for e.g.u. Then we have u[v]. This then defines a line. The problem here is, that the solution is multivalued. We therefore create as many plots as needed and combine them with "Show"

disp[d0_, z0_] := Module[{cu, iter},
  {cu, iter} = 
   Cases[sol[[1, 1]], _[
       c1_, _[c2_, _, c3_, _, c4_]] -> {c1, {c3, c2, c4}}, {1}][[1]];
  ParametricPlot[Evaluate[xy /. u -> cu], Evaluate[iter], 
   PlotLabel -> StringForm["z=``", z0]]
  ]

    xy = {1.16^v Cos[v] (1 + Cos[u]), -1.16^v Sin[v] (1 + Cos[u])};
    Manipulate[
     sol = Solve[{-2 1.16^v (1 + Sin[u]) == z0, 
         0 <= u <= 2 Pi, -15 <= v <= 6}, u] // Quiet;
     Show[disp[#, z0] & /@ sol]
     , {z0, -9, 0}, TrackedSymbols :> z0]

Answer 5

• Also using MeshFunctions.
• Using MeshShading -> {Automatic, None} or MeshShading -> {None, None} to remove some parts of surfaces.

Clear[f, plot, range];
f[u_, v_] = {1.16^v Cos[v] (1 + Cos[u]), -1.16^v Sin[
     v] (1 + Cos[u]), -2 1.16^v (1 + Sin[u])};
SetOptions[ParametricPlot3D, MeshFunctions -> {#3 &}, 
  PlotPoints -> 50, MaxRecursion -> 2, PerformanceGoal -> "Quality", 
  PlotRange -> range];
plot = ParametricPlot3D[f[u, v], {u, 0, 2 Pi}, {v, -15, 6}, 
   PlotRange -> All];
range = PlotRange /. AbsoluteOptions[plot, PlotRange];
Manipulate[
 Module[{plot}, 
  plot = ParametricPlot3D[f[u, v], {u, 0, 2 Pi}, {v, -15, 6}, 
    Mesh -> {{h}}, MeshStyle -> {Thick, Red}, 
    MeshShading -> {Automatic, None}, ImageSize -> Medium]; {plot, 
   Graphics[{Red, 
     Cases[Normal[
         Show[plot, PlotRange -> range, ViewPoint -> Top, 
          ViewProjection -> "Orthographic"]], Line[pts_] :> pts, 
        Infinity] /. {x_Real, y_Real, z_Real} :> {x, y} // Line}, 
    Frame -> True, ImageSize -> Medium, 
    PlotRange -> Most[range]]}], {h, Sequence @@ Last[range]}]