Wrapping image to a surface as a graphics object

Question

I am trying to make a model solar system, and noticed that mathematica already has the data to construct a 3D model of the planet in question with

PlanetData["Earth","Textured Surface"]

But this works as the plot object below.

SphericalPlot3D[1 , {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None,TextureCoordinateFunction -> ({#5, 1 - #4} &),PlotStyle -Directive[Specularity[White, 10], Texture[IMAGE]]], Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip"]

(IMAGE stands in for the image, which is copy/pasteable, but not good on the stack exchange site) I can easily get the image that is on the surface, but my issue comes in when trying to "paste" this on the sphere graphics primitive. Basically, I want to be able to use an image in the same way as the directive Blue used below.

Graphics3D[{Blue,Sphere[{0,0,0},1]}]

Alternatively, If a way could be found to make the plot object more manipulatable (dynamic coordinates for the center of the sphere basically), that would work as well.

score 2 · Accepted Answer · answered Feb 10 '17 at 20:07

If you create the plot with a texture coordinate function but no texture you can extract the polygons and supply the texture as a directive in Graphics3D. Translate and Scale can set the position and size. This gives a usage close to what you want:

texturedsphere = FirstCase[
    SphericalPlot3D[1, {u, 0, Pi}, {v, 0, 2 Pi},
     Mesh -> None, PlotTheme -> "Classic",
     TextureCoordinateFunction -> ({#5, 1 - #4} &)],
    _GraphicsComplex] /. _[Lighting, _] -> Nothing;

mysphere[pos_, rad_] := texturedsphere ~Scale~ rad ~Translate~ pos

t1 = ExampleData[{"ColorTexture", "RedApple"}];
t2 = ExampleData[{"ColorTexture", "CheetahFur"}];

Graphics3D[{
  Texture[t1], mysphere[{0, 0, 0}, 1],
  Texture[t2], mysphere[{0, 3, 0}, 0.5]}]

Wrapping image to a surface as a graphics object

1 Answers1