# Image3D and Graphics3D

also I guess that the topic was tackled in Combining Image3D and Graphics3D. My question is quite similar: How do I match the coordinate Systems of Graphics3D and Image3D?

Here some code:

z = 1;
p = RandomInteger[100, {z, 3}];
r = RandomInteger[10, {z}];
spheres = MapThread[RotateLeft[DiskMatrix[#1, {100, 100, 100}], #2] &, {r, p}];
i = Image3D[Plus @@ spheres, Axes -> True, AxesLabel -> {"x", "y", "z"}]
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj,
Axes -> True,
AxesLabel -> {"x", "y", "z"},
PlotRange -> {{0, 100}, {0, 100}, {0, 100}}]
Show[i, gr, Axes -> True]


Can anyone explain to me how to match the coordinate systems, that the spheres match?

• seems related to this mathematica.stackexchange.com/questions/23766/… – xslittlegrass Sep 26 '13 at 15:55
• @xslittlegrass: yes, i know. but i cant solve it with that. – Bimmel Sep 26 '13 at 16:00
• i guess you need to elaborate on whats different. Looks like a duplicate question. – george2079 Sep 26 '13 at 16:41

Firstly, you need to apply {50,50,50} shift to DiskMatrix. It is because DiskMatrix produces sphere with the center at {50,50,50}.

Image3D has different axes directions than Graphics3D so you need to search through numerous variants of transpositions and reflections. I found the following combination:

z = 10;
p = RandomInteger[100, {z, 3}];
r = RandomInteger[10, {z}];

spheres =
Transpose[#, {3, 2, 1}] &@Reverse@RotateLeft[
DiskMatrix[#1, {100, 100, 100}], #2 - {50, 50, 50}] &, {r, p}];
i = Image3D[Plus @@ spheres, Axes -> True,
AxesLabel -> {"x", "y", "z"}];
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj, Axes -> True, AxesLabel -> {"x", "y", "z"},
PlotRange -> {{0, 100}, {0, 100}, {0, 100}}];
Show[i, gr, Axes -> True] • +1 Much nicer way to do the geometric transformations than what I proposed with GeometricTransformation. – bobthechemist Sep 26 '13 at 17:35

This still may be considered a duplicate, but it's also possible that there is something odd happening with the formation of spheres. A set of geometric transformations (rotations, reflections and finally a scaling) gives close to overlap. Note I got rid of the randomness to make this problem a bit easier to navigate and did not nest the GeometricTransformations so that each one could be visualized if desired.

z = 5;
p = {{50, 50, 50}, {10, 10, 10}, {90, 90, 10}, {90, 10, 90}, {10, 90,
90}};
r = {2, 4, 6, 8, 10};
spheres =
MapThread[RotateLeft[DiskMatrix[#1, {100, 100, 100}], #2] &, {r, p}];
i = Image3D[Plus @@ spheres, Axes -> True,
AxesLabel -> {"x", "y", "z"}];
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj, Axes -> True, AxesLabel -> {"x", "y", "z"},
PlotRange -> {{0, 100}, {0, 100}, {0, 100}}];
objreflected =
GeometricTransformation[obj,
ReflectionTransform[{0, 0, 1}, {50, 50, 50}]];
objrotated = GeometricTransformation[
GeometricTransformation[objreflected,
RotationTransform[180 Degree, {1, 0, 0}, {50, 50, 50}]],
RotationTransform[100 Degree, {0, 1, 0}, {50, 50, 50}]];
objscaled =
GeometricTransformation[objrotated,
ScalingTransform[{0.4, 0.4, 0.4}, {50, 50, 50}]];
Show[i, Graphics3D@objscaled] Why the central sphere gets blown up in the image3d portion of the graphic is beyond me.

I don't quite understand how you built the Image3D object. I notice that the sphere doesn't seem to go where you put the points. For example, if I put the point right in the middle of the coordinate system, they end up out at the corners

p = {{50, 50, 50}};
r = {10};
spheres =
MapThread[RotateLeft[DiskMatrix[#1, {100, 100, 100}], #2] &, {r, p}];
i = Image3D[Plus @@ spheres, Axes -> True,
AxesLabel -> {"x", "y", "z"}, ImageSize -> 300];
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj, Axes -> True, AxesLabel -> {"x", "y", "z"},
PlotRange -> {{0, 100}, {0, 100}, {0, 100}}, ImageSize -> 300];
Grid[{{i,
gr}, {Show[i, gr, Axes -> True, ImageSize -> 300,
AxesLabel -> {"x", "y", "z"}], SpanFromLeft}}] So if I try to recreate what I think you are going for, I do the following

p1 = N[p[]];
r1 = N[r[]];
table = Table[
If[EuclideanDistance[{x, y, z}, p1] <= r1, 1, 0], {z, 100}, {y,
100}, {x, 100}];
i2 = Image3D[table, Axes -> True, AxesLabel -> {"x", "y", "z"}] Looks good, but if you try to use a less symmetric point as the center of the sphere, it gets all wonky (that's a technical term).

p1 = {10.0, 20.0, 30.0};
r1 = N[r[]];
table = Table[
If[EuclideanDistance[{x, y, z}, p1] <= r1, 1, 0], {z, 100}, {y,
100}, {x, 100}];

i2 = Image3D[table, Axes -> True, AxesLabel -> {"x", "y", "z"}] I don't understand why, but the only way I can get Image3D to work is to apply Reverse to two of the axes. The following works:

z = 1;
p = RandomInteger[100, {z, 3}];
r = RandomInteger[10, {z}];
i = Module[{p1, r1, table},
p1 = N[p[]];
r1 = N[r[]];
table =
Table[If[EuclideanDistance[{x, y, z}, p1] <= r1, 1, 0], {z,
100}, {y, 100}, {x, 100}];
Image3D[Reverse[table, {1, 2}], Axes -> True,
AxesLabel -> {"x", "y", "z"}]];
obj = GraphicsComplex[p, Sphere[Range[z], r]];
gr = Graphics3D[obj, Axes -> True, AxesLabel -> {"x", "y", "z"},
PlotRange -> {{0, 100}, {0, 100}, {0, 100}}];
Show[i, gr, Axes -> True] To me, Image3D is too buggy to use. Half the time I try to do something with it, it crashes my kernel. I want there to be a cool ListDensityPlot3D function, but I'll have to wait I think.