# Contour plot of a sequence of spheres with increasing radius

I am trying to do a simple thing really, plot a sequence of spheres with increasing radii and I used a Do-loop to do it, but nothing happens, Please suggest what I can do to get the result I want?

Do[
ContourPlot3D[x^2 + y^2 + z^2 == i, {x, 0, 10}, {y, 0, 10}, {z, 0, 10}],
{i, 0, 10}]


It should be a series of spheres almost side by side

See the image; the spheres should be stepped with different origins. • What is your desired end goal? An animation of some sort? Or perhaps all on the same graph? We can help! Welcome to Mma.SE. As a start, Do does not actually return anything unless explicitly informed to do so. – CA Trevillian Sep 7 at 5:39
• I have told Do to do a ContourPlot3D. I want simply a sequence of spheres with increasing radius in a 3D plot as mentioned. – Betty Sep 7 at 5:47
• Right right, so Do wasn’t told to Return that evaluation. See here: “Unless an explicit Return is used, the value returned by Do is Null.” Are you trying to Show a sequence of these on the same plot at the same time? Or output sequence of them in a List, such as with a Table? You could also Animate the sequence, or wrap it in a Manipulate so you have control over it! – CA Trevillian Sep 7 at 5:56
• That is okay it sort of does what I want but I do not want manipulation but a superposition all spheres but they have changing origin, so that they are almost side by side – Betty Sep 7 at 6:10

spacing = 1;
ClearAll[tr]
tr[n_] := (n^2 - 1) / 2 / spacing;


You can use tr and radii with

### ContourPlot

ContourPlot[Evaluate[(x - tr[#])^2 + y^2 == #^2 & /@ radii],
{x, -1, 65}, {y, -10, 10},
ContourStyle -> Thick, AspectRatio -> Automatic,  Frame -> False, ImageSize -> 1 -> 5] ### ParametricPlot

ParametricPlot[Evaluate[{# Cos[t] + tr@#, # Sin[t]} & /@ radii],
{t, 0, 2 Pi},
AspectRatio -> Automatic, PlotStyle -> Thick, Axes -> False,
Frame -> False, ImageSize -> 1 -> 5]


same picture

### Graphics

Graphics[{Thick, ColorData@#, Circle[{tr@#, 0}, #]} & /@ radii]


same picture

### ContourPlot3D

ContourPlot3D[Evaluate[(x - tr[#])^2 + y^2 + z^2 == #^2 & /@ radii],
{x, -1, 65}, {y, -10, 10}, {z, -15, 15},
Mesh -> None, ContourStyle -> Opacity[.5], BoxRatios -> Automatic,
ViewPoint -> Front, Boxed -> False, Axes -> False , PlotPoints -> 60] ### ParametricPlot3D

ParametricPlot3D[Evaluate[{# Cos[u] Sin[v] + tr@#, # Sin[u] Sin[v], # Cos[  v]} & /@ radii],
{v, 0, Pi}, {u, 0, 2 Pi},
Mesh -> None, BoundaryStyle -> None, PlotStyle -> Opacity[.5],
Axes -> False, Boxed -> False, BoxRatios -> Automatic, ViewPoint -> Front]


same picture

### Graphics3D

styles = "DefaultPlotStyle" /.
(Method /. ChartingResolvePlotTheme[Automatic, ContourPlot3D]);

Graphics3D[{Opacity[.5], styles[[#]], Sphere[{tr @ #, 0, 0}, #]} & /@ radii,
Boxed -> False, ViewPoint -> Front]


same picture

To get horizontal coordinates of the centers of the circles/spheres (1) Accumulate the diameters of circles/spheres in odd and even positions separately, (2) shift the second list by an arbitrary amount (by the average of the horizontal positions the two leftmost circles/spheres below), (3) riffle the two lists and (4) subtract the radii from the resulting list:

SeedRandom
randomradii = RandomSample[Range @ 20, 10];
centers = Module[{origins = {0, Mean[Sort[#][[{1, 2}]]]}}, Riffle @@
(Function[x, origins[[x]] + Accumulate[2 #[[x ;; ;; 2]]]] /@ {1, 2}) - #] &@ randomradii;


Using centers and randomradii with Graphics and Graphics3D:

Graphics[MapIndexed[{Thick, ColorData@#2[],

Graphics3D[MapIndexed[{Opacity[.5], ColorData@#2[],
Sphere[{centers[[#2[]]], 0, 0}, #]} &, randomradii],
Boxed -> False, ViewPoint -> Front] SeedRandom
randomradii = Sort@ RandomChoice[Range @ 20, 10];


we get • Can this be done without the use of Sphere[]? – Betty Sep 8 at 7:26
• ParametricPlot3D and ContourPlot3D do not use Sphere[] – kglr Sep 9 at 18:02
• Excellent work, it gives me a starting point for what I want to do - thank you. – Betty Sep 9 at 23:22

As mentioned in comments, Do does not return the plots. But why not just use Manipulate? This is what Manipulate meant for. Manipulate[

Module[{x, y, z, max},
max = 10;
ContourPlot3D[
x^2 + y^2 + z^2 == r^2, {x, -max, max}, {y, -max, max}, {z, -max, max},
PlotRange -> {{-max, max}, {-max, max}, {-max, max}},
PerformanceGoal -> "Quality",
SphericalRegion -> True]
],

{{r,5,"radius"}, 1, 10, 1, Appearance -> "Labeled",ContinuousAction->False},
TrackedSymbols :> {r}
]


But if you really just need static 3D plots, you can do

makePlot[r_] := Module[{x, y, z, max},
max = 10;
ContourPlot3D[
x^2 + y^2 + z^2 == r^2, {x, -max, max}, {y, -max, max}, {z, -max, max},
PlotRange -> {{-max, max}, {-max, max}, {-max, max}},
PerformanceGoal -> "Quality", SphericalRegion -> True,
];

Grid[Partition[Table[makePlot[r], {r, 1, 9}], 3], Frame -> All,


Spacings -> {1, 1}] To update for the new requirements posted:

makePlot[r_] := Module[{x, y, z, max},
Sphere[{r^2 - 1, 0, 0}, r]
];
tab = Table[makePlot[r], {r, 1, 4}]
Graphics3D[tab, PlotRange -> All]
` • See below I uploaded an image – Betty Sep 7 at 6:13
• Nice answer! +1 I think the OP has defined their needs a bit more, though you’ll likely be able to accommodate quite considerably with these! – CA Trevillian Sep 7 at 6:14
• Can this be done without the use of the Sphere[] function? – Betty Sep 8 at 7:26