7
$\begingroup$

enter image description here

I am trying to plot a set up for a classic problem of physics of fluids using Mathematica, see Wikipedia for a reference.

The problem is the movement of two concentric cylinders with two radii and velocities, as is shown in the figure.

I could generate two concentric cylinders using the following lines

 u1 = ContourPlot3D[4 == x^2 + y^2, {x, -3, 3}, {y, -3, 3}, {z, -2, 2},
   Mesh -> None, PlotPoints -> 20, ColorFunction -> Black];

u2 = ContourPlot3D[x^2 + y^2 == 1, {x, -3, 3}, {y, -3, 3}, {z, -2, 2},
    Mesh -> None, ColorFunction -> Blue];

Show[{u1, u2}]

It is possible to add vectors, radii, velocities? Any suggestions are welcome.

$\endgroup$
10
$\begingroup$
color = RGBColor[0.454, 0.695, 0.875];

u1u2 = ContourPlot3D[{4 == x^2 + y^2, x^2 + y^2 == 1}, 
      {x, -3, 3}, {y, -3, 3}, {z, -2, 2}, 
   Mesh -> None, PlotPoints -> 20, Lighting -> {{"Ambient", White}},
   ContourStyle -> {FaceForm[Opacity[0], Opacity[1, color]], 
   Opacity[1, LightGray]}];

arrows = Graphics3D[{FaceForm[Opacity[1, color]], 
   Polygon[Append[#, -2] & /@ CirclePoints[{0, 0}, {2, π}, 100]],
   Arrowheads[Large, Appearance -> "Projected"], 
   Arrow[{{0, 0, 2}, {#2 Cos@#, #2 Sin@#, 2}} & @@@ Transpose[{{0, - π/2}, {2, 1}}]], 
   Arrow[Append[Reverse@#, 3] & /@ CirclePoints[{0, 0}, {1, 0}, 100]], 
   Arrow[Append[#, -3] & /@ CirclePoints[{0, 0}, {2, 0}, 100]],
   Arrowheads[{{-.03, 1}, {-.03, 1/3}, {-.03, 2/3}}, Appearance -> "Projected"] , 
   Table[Arrow[Append[#, i] & /@ CirclePoints[{0, 0}, {1.5, π}, 100]], 
       {i, Subdivide[-1, 1, 2]}]}];

texts = Graphics3D[{ Text[Style[Subscript["R", 2], 12], {.7, 0, 2.2} ],
  Text[Style[Subscript["R", 1], 12], {-.2, -.5, 2.2} ],
  Text[Style[Subscript["Ω", 1], 14], {-Cos[π/4], Sin[π/4], 3.2} ],
  Text[Style[Subscript["Ω", 2], 14], 1.65 {-Cos[-2 π + π/16], Sin[-2 π + π/16], -3} ]}];


Show[u1u2, arrows, texts,
  PlotRange -> All, Boxed -> False, Axes -> False, BoxRatios -> {1, 1, 3}]

enter image description here

$\endgroup$
  • $\begingroup$ To improve the figure, What are the commands to add the radios and velocities into the code? Thanks $\endgroup$ – irondonio Jul 29 at 4:16
  • $\begingroup$ @irondonio, radii and velocities ("Ω"s are velocities I assume) are added using Text[...]. $\endgroup$ – kglr Jul 29 at 4:25
6
$\begingroup$

You can do this with graphics primitives. The only real problem I encountered was the size of the arrowheads. For some reason, they blow up randomly...

polygonPts = 
  Table[{Cos[th], Sin[th], z}, {z, {0, 3}}, {th, 0, Pi, Pi/50}];
polygons = 
  MapThread[Polygon@Join[#, Reverse[#2]] &, 
   Partition[#, 2, 1] & /@ polygonPts];
arrowPts = 
  Transpose@
   Table[{((1 + r)/2) Cos[th], ((1 + r)/2) Sin[th], z}, {th, 0, 2 Pi, 
     Pi/50}, {z, {0.8, 1.6, 2.4}}];
cylinderOutlinePts = 
  Table[{Cos[th], Sin[th], 3}, {th, 0, Pi, Pi/50}];
lowerArrowPts = 
  Table[{0.9 Cos[th], 0.9 Sin[th], -0.5}, {th, -Pi/2, 2 Pi - Pi/2, 
    Pi/50}];
upperArrowPts = 
  Table[{0.5 Cos[th], 0.5 Sin[th], 3.25}, {th, -Pi/2, 2 Pi - Pi/2, 
    Pi/50}];

r = 0.6;
Graphics3D[{
  Line[{{-r, 0, 0}, {-r, 0, 3}}],
  Line[{{r, 0, 0}, {r, 0, 3}}],
  Line[{{-1, 0, 0}, {-1, 0, 3}}],
  Line[{{1, 0, 0}, {1, 0, 3}}],
  Line[cylinderOutlinePts],
  Arrow[lowerArrowPts],
  Arrow[upperArrowPts],
  Arrowheads[{{Automatic, 0}, {Automatic, 0.5}}, 
   Appearance -> "Projected"],
  Arrow[arrowPts],
  LightGray,
  Cylinder[{{0, 0, 0}, {0, 0, 3}}, r],
  LightBlue,
  Cylinder[{{0, 0, 0}, {0, 0, 0.001}}],
  EdgeForm[None],
  polygons
  }, Lighting -> {"Ambient", White}, Boxed -> False]

Mathematica graphics

$\endgroup$

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.