20
$\begingroup$

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?

Improve this question
$\endgroup$
1
  • 2
    $\begingroup$ I just added a comment to Heike's answer and should put it here, too: replace Directive[Texture[image]] by Directive[Texture[ImageData@image]]. $\endgroup$ Commented May 2, 2012 at 2:54

2 Answers 2

Reset to default
23
$\begingroup$

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

Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ Scale is nice:) $\endgroup$ Commented Jan 17, 2012 at 23:42
  • 1
    $\begingroup$ D'oh. Graphics in Mathematica is wonderful, but it's never obvious how you can do things. $\endgroup$ Commented Jan 17, 2012 at 23:42
  • 2
    $\begingroup$ Just saw that this is still suffering from a little texture bug: Try exporting to PDF: the texture looks wrong. To fix it, you can replace Directive[Texture[image]] by Directive[Texture[ImageData@image]]. That's also how to make transparent textures work properly. $\endgroup$ Commented May 2, 2012 at 2:52
5
$\begingroup$

Maybe begin with something like

sphere /. 
  GraphicsComplex[pts_, others__] :> 
   GraphicsComplex[1.1 pts, others] // Show[#, PlotRange -> All] &
Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.