Onion plot of a ball
Like this?
ContourPlot3D[x^2 + y^2 + z^2, {x, 0, 1}, {y, 0, 1}, {z, 0, 1},
ContourStyle -> Directive[Opacity[.5], ColorData[97][1]],
Axes -> False,
Contours -> {0.25, .5, .75},
Mesh -> None
]
Update: Post-process RegionPlot
outputs to remove the walls:
colors = ColorData[97] /@ Range[4];
radii = {1, 3/4, 1/2, 1/4};
regionplots = RegionPlot3D[x^2 + y^2 + z^2 <= #^2, {x, 0, 1}, {y, 0, 1}, {z, 0, 1},
Mesh -> None, BoundaryStyle -> None, Axes -> False] & /@ radii;
Graphics3D[{EdgeForm[], FaceForm[{Opacity[.5], #[[2]]}],
Cases[Normal[#[[1]]][[1]], _GraphicsGroup, All][[1]]}&/@Transpose[{regionplots, colors}],
Boxed -> False]
Alternatively, delete the Polygon
s with constant VertexNormals
:
Show[DeleteCases[Normal@RegionPlot3D[x^2 + y^2 + z^2 <= #^2,
{x, 0, 1}, {y, 0, 1}, {z, 0, 1},
BoundaryStyle -> None, Mesh -> None, BaseStyle -> Opacity[.5],
PlotStyle -> #2, Axes -> False],
Polygon[_, VertexNormals -> {{a_, b_, c_} ..}], All] & @@@
Transpose[{radii, colors}], Boxed -> False]
Original answer:
You can use a combination of ImplicitRegion
and DiscretizeRegion
as follows:
ir[r_] := ImplicitRegion[x^2 + y^2 + z^2 == r^2, {{x, 0, 1}, {y, 0, 1}, {z, 0, 1}}]
radii = {1, 3/4, 1/2, 1/4};
colors = ColorData[97] /@ Range[4];
boundaries = RegionPlot3D[x^2 + y^2 + z^2 <= 1.1,
{x, 0, 1}, {y, 0, 1}, {z, 0, 1},
MeshFunctions -> (Sqrt[#1^2 + #2^2 + #3^2] &),
Mesh -> {Transpose[{radii, colors}]}, MeshStyle -> Thick,
PlotStyle -> Opacity[0], Axes -> False, BoundaryStyle -> None];
i = 1;
surfaces = DiscretizeRegion[ir[#],
MeshCellStyle -> {{2, All} -> Opacity[0.5, colors[[i++]]]}] & /@ radii;
Legended[Show[surfaces, boundaries],
SwatchLegend[colors, "radius = " <> ToString[#, StandardForm] & /@ radii]]