1
$\begingroup$

The (inspired) solution by @aardvark2012 to this original question: Transform a RegionFunction in ContourPlot3D worked well until an update appears to have changed the expected behavior (some time since ~2017):

If you specify PlotPoints -> 10 you still get the expected result:

enter image description here

If you specify PlotPoints -> 25 you get the unexpected result: enter image description here

How do we get just the spot on the cylinder?

Although the original solution used PlotPoints -> 10, I have many similar constructions which previously give the expected result but now do not, so at that point @aardvark2012's solution was a general solution.

Here's @aardvark2012's solution from the above post: if you change PlotPoints -> 10 to PlotPoints -> 25 you get the unexpected result above. I needed to increase PlotPoints as the outline for other similar constructions was too coarse.

With[{a = 0.5, b = 0.5, r = 5, l = 10, c = 50}, 
  Show[
    ContourPlot3D[
      x^2/r^2 + y^2/r^2 == 1, {x, -r, r}, {y, -r, r}, {z, 0, l}, 
      Mesh -> None, PerformanceGoal -> "Quality", PlotRange -> {{-r - 1, r + 1}, {-r - 1, r + 1}, {0, l}}, 
        PlotPoints -> 10, ContourStyle -> Opacity[0.5]], 

    ContourPlot3D[
      x^2/r^2 + y^2/r^2 == 1, {x, -r, r}, {y, -r, r}, {z, 0, l}, 
      RegionFunction -> 
        Function[{x, y, z}, 
          Evaluate@
            RegionMember[
            TransformedRegion[
              ImplicitRegion[(x/a)^2 + (y/b)^2 <= 1 + (z/c)^2, {{x, -r, r}, {y, -r, r}, {z, 0, l}}], 
                RotationTransform[{{0, 0, 1}, {0, 1, 1}}]], {x, y, z}]], 
      Mesh -> None, PerformanceGoal -> "Quality", 
      PlotRange -> {{-r, r}, {-r, r}, {0, l}}, PlotPoints -> 10], 

    ViewPoint -> {Pi, Pi/2, 2}]
]
$\endgroup$

1 Answer 1

2
$\begingroup$
  • RegionBoundaryStyle -> None.
With[{a = 0.5, b = 0.5, r = 5, l = 10, c = 50}, 
 Show[ContourPlot3D[
   x^2/r^2 + y^2/r^2 == 1, {x, -r, r}, {y, -r, r}, {z, 0, l}, 
   Mesh -> None, PerformanceGoal -> "Quality", 
   PlotRange -> {{-r - 1, r + 1}, {-r - 1, r + 1}, {0, l}}, 
   PlotPoints -> 25, ContourStyle -> Opacity[0.5]], 
  ContourPlot3D[
   x^2/r^2 + y^2/r^2 == 1, {x, -r, r}, {y, -r, r}, {z, 0, l}, 
   RegionFunction -> 
    Function[{x, y, z}, 
     Evaluate@
      RegionMember[
       TransformedRegion[
        ImplicitRegion[(x/a)^2 + (y/b)^2 <= 
          1 + (z/c)^2, {{x, -r, r}, {y, -r, r}, {z, 0, l}}], 
        RotationTransform[{{0, 0, 1}, {0, 1, 1}}]], {x, y, z}]], 
   Mesh -> None, PerformanceGoal -> "Quality", 
   PlotRange -> {{-r, r}, {-r, r}, {0, l}}, PlotPoints -> 25, 
   RegionBoundaryStyle -> None], ViewPoint -> {Pi, Pi/2, 2}]]

enter image description here

  • Another way is using MeshFunction.
With[{a = 0.5, b = 0.5, r = 5, l = 10, c = 50}, 
 ContourPlot3D[
  x^2/r^2 + y^2/r^2 == 1, {x, -r, r}, {y, -r, r}, {z, 0, l}, 
  Mesh -> {{0}}, MeshShading -> {Blue, Automatic}, 
  ContourStyle -> Opacity[0.5], 
  MeshFunctions -> 
   Function[{x, y, z}, 
    Evaluate[(x/a)^2 + (y/b)^2 - (1 + (z/c)^2) /. 
      Thread[{x, y, z} -> {x, y, z} . 
         RotationMatrix[{{0, 0, 1}, {0, 1, 1}}]]]], PlotPoints -> 50, 
  MaxRecursion -> 4, MeshStyle -> Yellow, 
  PlotRange -> {{-r - 1, r + 1}, {-r - 1, r + 1}, {0, l}}, 
  ViewPoint -> {Pi, Pi/2, 2}]]

enter image description here

$\endgroup$
1
  • $\begingroup$ Nice solution incorporating the MeshFunction into the ContourPlot3D rather than using two instances of ConcoutPlot3D. Much appreciated. $\endgroup$
    – DrBubbles
    Oct 17, 2022 at 19:32

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.