19
$\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$
    – Jens
    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$
    – Silvia
    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$
    – Mike Bailey
    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$
    – Jens
    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$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.