4
$\begingroup$

I using the ClipPlanes to achieve a section, the code as below:

Show[
 {Graphics3D[Cylinder[{{0, 0, 5}, {0, 0, 20}}, 15]], 
  ParametricPlot3D[
    {(10 + 5 Sin[β]) Cos[θ], (10 + 5 Sin[β]) Sin[θ], 5 (1 - Cos[β])}, 
    {β, 0, π/2}, {θ, 0, 2 π}, Mesh -> None], 
  Graphics3D[
    Polygon[CirclePoints[10, 50] /. {x_, y_} :> {x, y, 0}]]},
  ClipPlanes -> {{0, -Sin[20 \[Degree]], Cos[20 \[Degree]], -2}}, 
  Boxed -> False, ViewPoint -> {7, 0, 0}, ImageSize -> 300]

enter image description here

However, for the coordinate of the section, I have no idea.

enter image description here

So I would like to know:

  • Is there a workaround to achieve the coordinate of section?
$\endgroup$
4
$\begingroup$

You need the intersection between your surface and a plane defined by

{0, -Sin[20 °], Cos[20 °], -2}.{x, y, z, 1} == 0

One way to get the intersection points is to use MeshFunctions to create a line and then use Cases to extract the line:

eqn = {0, -Sin[20 °], Cos[20 °], -2}.{x, y, z, 1};
meshopts = 
  {Mesh -> {{0}}, 
   MeshFunctions -> {Function[{x, y, z, f}, eqn]}, 
   MeshStyle -> {{Thick, Blue}}};
plot = Show[
 ParametricPlot3D[
   {15 Cos[th], 15 Sin[th], z}, 
   {th, 0, 2 π}, {z, 5, 20}, Evaluate@meshopts], 
 ParametricPlot3D[
   {r Cos[th], r Sin[th], 0}, 
   {th, 0, 2 π}, {r, 0, 10}, Evaluate@meshopts],
 ParametricPlot3D[
   {(10 + 5 Sin[β]) Cos[θ], (10 + 5 Sin[β]) Sin[θ], 5 (1 - Cos[β])}, 
   {β, 0, π/2}, {θ, 0, 2 π}, Evaluate@meshopts],
 PlotRange -> {{-16, 16}, {-16, 16}, {-1, 21}},
 ClipPlanes -> {{0, -Sin[20 °], Cos[20 °], -2}}, 
 Boxed -> False, Axes -> False
]

enter image description here

Notice the line follows the ClipPlanes exactly.

points = Cases[Normal@plot, Line[a__] :> a, Infinity]~Flatten~1;

Graphics3D@Point@points

Mathematica graphics

Edit

Above I chose to show your Cylinder as a ParametricPlot3D because I like the look better. But if you still want to use a Cylinder, then you need to visualize it with some plotting program that takes MeshFunction options, and Graphics3D and Show do not. This works:

plot = Show[
  RegionPlot3D[Cylinder[{{0, 0, 5}, {0, 0, 20}}, 15], 
   Evaluate@meshopts], 
  ParametricPlot3D[{(10 + 5 Sin[β]) Cos[θ], (10 + 
       5 Sin[β]) Sin[θ], 5 (1 - Cos[β])}, {β,
     0, π/2}, {θ, 0, 2 π}, Evaluate@meshopts],
  PlotRange -> {{-16, 16}, {-16, 16}, {-1, 21}}, 
  ClipPlanes -> {{0, -Sin[20 °], Cos[20 °], -2}}, 
  Boxed -> False, Axes -> False
  ]

enter image description here

and you can extract the points in the same way.

$\endgroup$
7
  • $\begingroup$ Thanks for your MeshFunctions strategy, but I would like know: is it possible to smooth the section that achieved with help of MeshFunctions. $\endgroup$
    – xyz
    May 13 '16 at 14:24
  • $\begingroup$ @ShutaoTANG - I don't follow, what are you looking to smooth? $\endgroup$
    – Jason B.
    May 13 '16 at 14:26
  • $\begingroup$ like this $\endgroup$
    – xyz
    May 13 '16 at 14:28
  • $\begingroup$ @ShutaoTANG - if you are using the first plot above then you can get better results by setting PlotPoints->100 in the ParametricPlot3D calls. RegionPlot3D is just awful though, so you can't get great results there. $\endgroup$
    – Jason B.
    May 13 '16 at 14:45
  • 1
    $\begingroup$ If I use the higher plotpoints setting, then run the command: points = Cases[Normal@plot, Line[a__] :> a, Infinity]; Graphics[Line /@ points[[All, All, ;; 2]]] I get this: i.stack.imgur.com/7xuTv.png $\endgroup$
    – Jason B.
    May 13 '16 at 14:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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