3
$\begingroup$

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.

$\endgroup$
2
$\begingroup$

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]}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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