Imprecise 3D plot

Question

I'm plotting the following figure: There are two issues: There is some noise around the edges of the section of the torus, see figure below The torus is not smooth enough (modulo rasterization of the image) Here's the coode producing the plot: h = .3; c = .9; T = ParametricPlot3D[{(2 + c Cos[2 [Pi] v]) Sin[ 2 [Pi] u], (2 + c Cos[2 [Pi] v]) Cos[2 [Pi] u], c Sin[2 [Pi] v]}, {u, 0, 1}, {v, 0, 1}, RegionFunction -> Function[{x, y, z}, Abs[x] >= h && y >= 0 || y <= 0], Mesh -> {{0}}, PlotStyle -> {Opacity[.45], GrayLevel[0.95]}, PlotPoints -> 100, MaxRecursion -> 8, Exclusions -> None, ColorFunction -> ({Specularity[GrayLevel[0.2], 10], White} &) , Lighting -> {{"Directional", White, {-4, 0, 16}, {0, 0, 0}}}]; RT = ImplicitRegion[ y^2 + (Sqrt[x^2 + z^2] - 2)^2 <= c^2 && z >= 0, {{x, -5, 5}, {z, -5, 5}, {y, -5, 5}}]; RP1 = InfinitePlane[{h, 2, 0}, {{0, 0, 1}, {0, 1, 0}}]; S1 = RegionIntersection[RT, RP1]; S1D = DiscretizeRegion[S1, MaxCellMeasure -> {1 -> .01}, MeshCellStyle -> {{2, All} -> Opacity[.8, Red]}]; RP2 = InfinitePlane[{-h, 2, 0}, {{0, 0, 1}, {0, 1, 0}}]; S2 = RegionIntersection[RT, RP2]; S2D = DiscretizeRegion[S2, MaxCellMeasure -> {1 -> .01}, MeshCellStyle -> {{2, All} -> Opacity[.8, Blue]}]; Show[S1D, S2D, T, Axes -> False, AxesLabel -> {x, y, z}, ViewVector -> {-7, 0, 12}] To solve both the problems I tried with MaxRecursion, PlotPoints and Exclusions->None in the plot T, but nothing worked. Do you know how to solve this?

cvgmt · Answer

There two methods which can speed up the generation of the two circles.

Method I

Clear["`*"];
h = .3;
c = .9;
surf = y^2 + (Sqrt[x^2 + z^2] - 2)^2 - c^2;
T = ParametricPlot3D[{(2 + c Cos[2 Pi v]) Sin[
      2 Pi u], (2 + c Cos[2 Pi v]) Cos[2 Pi u], c Sin[2 Pi v]}, {u, 0,
     1}, {v, 0, 1}, 
   RegionFunction -> 
    Function[{x, y, z, u, v}, Abs[x] >= h && y >= 0 || y <= 0], 
   Mesh -> {{0}}, PlotStyle -> {Opacity[.45], GrayLevel[0.95]}, 
   PlotPoints -> 20, MaxRecursion -> 8, Exclusions -> None, 
   ColorFunction -> ({Specularity[GrayLevel[0.2], 10], White} &), 
   Lighting -> {{"Directional", White, {-4, 0, 16}, {0, 0, 0}}}];
disks = ParametricPlot3D[{{h, 2, 0} + u*{0, 0, 1} + 
     v*{0, 1, 0}, {-h, 2, 0} + u*{0, 0, 1} + v*{0, 1, 0}}, {u, -3, 
    3}, {v, -3, 3}, 
   RegionFunction -> Function[{x, z, y}, surf <= 0 && z >= 0], 
   PlotStyle -> {Opacity[.8, Red], Opacity[.8, Blue]}, Mesh -> None];
Show[disks, T, Boxed -> False, Axes -> False, 
 ViewVector -> {-7, 0, 12}, PlotRange -> All]

Method II

 Clear["`*"];
    h = .3;
    c = .9;
    surf = y^2 + (Sqrt[x^2 + z^2] - 2)^2 - c^2;
    render = {Specularity[GrayLevel[0.2], 10], Opacity[.45], 
       GrayLevel[0.95]};
    T = ParametricPlot3D[{(2 + c Cos[2 Pi v]) Sin[
          2 Pi u], (2 + c Cos[2 Pi v]) Cos[2 Pi u], c Sin[2 Pi v]}, {u, 0,
         1}, {v, 0, 1},
       MeshFunctions -> {Abs[#1] - h &, #2 &}, 
       MeshShading -> {{render, render}, {None, render}}, Mesh -> {{0}}, 
       BoundaryStyle -> None, MeshStyle -> None, PlotPoints -> 50, 
       Lighting -> {{"Directional", White, {-4, 0, 16}, {0, 0, 0}}}, 
       Boxed -> False, Axes -> False];
    disk1 = ParametricPlot3D[{h, 2, 0} + u*{0, 0, 1} + 
        v*{0, 1, 0}, {u, -4, 4}, {v, -4, 4}, Mesh -> {{0}, {0}, {0}}, 
       MeshFunctions -> {Function[{x, z, y}, surf], 
         Function[{x, z, y}, z]}, PlotPoints -> 50, 
       MeshShading -> {{None, None}, {Opacity[.8, Red], None}}, 
       BoundaryStyle -> None, MeshStyle -> None];
    disk2 = ParametricPlot3D[{-h, 2, 0} + u*{0, 0, 1} + 
        v*{0, 1, 0}, {u, -4, 4}, {v, -4, 4}, Mesh -> {{0}, {0}, {0}}, 
       MeshFunctions -> {Function[{x, z, y}, surf], 
         Function[{x, z, y}, z]}, PlotPoints -> 50, 
       MeshShading -> {{None, None}, {Opacity[.8, Blue], None}}, 
       BoundaryStyle -> None, MeshStyle -> None];
    Show[T, disk1, disk2, Boxed -> False, Axes -> False, 
     ViewVector -> {-7, 0, 12}, PlotRange -> All]

Imprecise 3D plot

One Answer

Add your own answers!

Ask a Question