8

How can you plot an annulus in 3D using the Graphics3D function? There is a function for 2D, but why not 3D?

I would like Annulus[{0, 0}, {.045, .05}] with a thickness of 0.01 at (x=0, y=0, z=0.08).

I feel like this should be really easy to do, but I'm struggling to find a good solution.

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
Daychay
  • 103
  • 6

3 Answers3

10

I knocked this up:

annulus3D[{x_, y_, z_: 0.08}, {r1_, r2_}, th_: 0.01] := 
 BoundaryDiscretizeRegion[
  RegionDifference[Cylinder[{{x, y, z}, {x, y, z + th}}, r2], 
   Cylinder[{{x, y, z}, {x, y, z + th}}, r1]]]

which made this

enter image description here

High Performance Mark
  • 1,534
  • 1
  • 10
  • 17
10

ChartElementData["CylindricalSector3D"]

ClearAll[annulus3dF]
annulus3dF[color_: LightBlue, o : OptionsPattern[]] := 
  Graphics3D[{EdgeForm[None], color, ChartElementData["CylindricalSector3D"][{##}, 1]}, o, 
    Boxed -> False] &;

Examples:

annulus3dF[][{0, 2 Pi}, {.045, 0.05}, {0, .01}]

enter image description here

Show[annulus3dF[Red, Axes -> True, Boxed -> True,
   PlotRange -> {0, .15}][{Pi/2, 2 Pi}, {.05, 0.07}, {.05, .1}], 
 Graphics3D[{EdgeForm[LightBlue], Opacity[.1], Blue,
   Cuboid[{-0.1, -.1, 0.05}, {0.1, .1, 0.1}]}]]

enter image description here

SeedRandom[5]
dt = Sort /@ # & /@ Transpose[RandomReal[#, {10, 2}] & /@{{0, 2 Pi}, {5, 20}, {-10, 30}}];
Show[annulus3dF[Directive[Opacity[.7], Hue[ RandomReal[]]]] @@ # & /@ dt, BoxRatios -> 1]

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896
8

Here are two possibilities. The first one uses the mesh-related capabilities of Mathematica:

With[{c = {0, 0}, r1 = 0.045, r2 = 0.05, h = 0.01}, 
     RegionProduct[BoundaryDiscretizeRegion[Annulus[c, {r1, r2}]],
                   MeshRegion[{{0}, {h}}, Line[{1, 2}]]]]

region-based solution


This second solution is a bit more involved, and uses NURBS to construct the thickened annulus:

annulus3D[c_?VectorQ, {r1_, r2_}, h_?Positive] /; 0 < r1 < r2 := 
    BSplineSurface[Map[TranslationTransform[c], 
                       Map[Function[pt, Append[#1 pt, #2]],
                           {{1, 0}, {1, 1}, {-1, 1}, {-1, 0},
                            {-1, -1}, {1, -1}, {1, 0}}] & @@@
                       {{r2, h}, {r1, h}, {r1, 0}, {r2, 0}}, {2}], 
                   SplineClosed -> True, SplineDegree -> {1, 2}, 
                   SplineKnots -> {{0, 0, 1/4, 1/2, 3/4, 1, 1},
                                   {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}}, 
                   SplineWeights -> Outer[Times, ConstantArray[1, 4],
                                          {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]

Using the same parameters:

Graphics3D[annulus3D[{0, 0, 0}, {.045, .05}, 0.01], Boxed -> False]

NURBS annulus

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574