Skip to main content

graphics3d - Texture mapping and resizing a sphere primitive in Mathematica


Background Info


In Mathematica, it's only possible to texture map a sphere through the use of SphericalPlot3D or ParametricPlot3D.



image = Import["MyTexture.jpg"]; (* Pretend this is something you'd use *)

sphere = SphericalPlot3D[1, {theta, 0, Pi}, {phi, 0, 2 Pi},
Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Texture[image]],
Lighting -> "Neutral", Axes -> False, Boxed -> False];

Now that's all nice and everything. But what if we want multiple spheres on the same exact image, each with an arbitrary size? To position a single sphere is simple:


s1 = Graphics3D[
Translate[First@sphere, {3, 2, 1}],

Lighting -> "Neutral"]

Then you just position each sphere and Show them together:


Show[{s1, s2}, PlotRange->{{-5, +5}, {-5, +5}, {-5, +5}}]



The Issue


That's great and all, but what if you need each sphere to be a distinct size? Positioning and sizing regular Sphere[] primitives is easy and built directly into their definition.


But if I want the same for a textured sphere, I have to jump through all these hoops. Furthermore, it's not obvious how I can achieve this.


Any ideas on how I can achieve arbitrary placement and sizing of textured spheres?




Answer



You could use a combination of Translate and Scale. Suppose the radii and centres of the circles are given by


radii = RandomReal[{.1, .6}, 8];
centres = RandomReal[{-2, 2}, {8, 3}];

Then using the original sphere


image = ExampleData[{"ColorTexture", "GiraffeFur"}];
sphere = SphericalPlot3D[1, {theta, 0, Pi}, {phi, 0, 2 Pi}, Mesh -> None,
TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Texture[image]], Lighting -> "Neutral",

Axes -> False, Boxed -> False];

You could do for example


Graphics3D[MapThread[Translate[Scale[sphere[[1]], #1], #2] &, {radii, centres}]]

Which produces something like this


Mathematica graphics


Comments