3
$\begingroup$

Using the techniques outlined in the answers to this and this questions, it's possible to map images as textures on the surface of a sphere or other object.

These questions, however, consider the case in which one wants to map a single image over the whole surface of a sphere. I am instead trying to plot different images at various points of the sphere.

A first attempt to do this is the following:

testImage[theta_, phi_] := 
  Rasterize[
   Framed@Text[
     "\[Theta]=" <> StringTake[ToString@N@theta, UpTo@3] "\n\[Phi]=" <>
        StringTake[ToString@N@phi, UpTo@3]], RasterSize -> {60, 60}];
Show[
 Graphics3D[{
   Sphere[{0, 0, 0}, 19.9]
   }, Axes -> True],
 Table[
  SphericalPlot3D[
   20, {u, theta - 0.1, theta + 0.1}, {v, phi - 0.1, phi + 0.1}, 
   Mesh -> None,
   TextureCoordinateFunction -> ({#5, 1 - #4} &),
   PlotStyle -> Directive[Texture[testImage[theta, phi]]],
   Lighting -> "Neutral"
   ],
  {theta, Subdivide[0., Pi, 10]},
  {phi, Subdivide[0., 2 Pi, 8]}
  ]
 ]

which produces

enter image description here

This is sort of what I am trying to achieve. However, there is the problem that the spherical coordinates distort the images the more they approach the poles.

I want instead to plot the images without any distortion around any given angle $(\theta,\phi)$. Clearly, if the list of images were the same as in this example we would get overlapping images, but that is not really a concern for my actual use case. I am also not concerned about the orientation of any single image, so one can assume that the images have rotational symmetry around their centres.

How can I do this?

$\endgroup$
3
$\begingroup$

Lazy approach is to create a properly shaped polygon with a texture and then rotate it wherever you want with that or replaced texture:

image = First @ SphericalPlot3D[ 1, {t, Pi/2 - .2, Pi/2 + .2}, {f, -.2, .2}, 
   PlotStyle -> Texture@ExampleData[{"TestImage", "Lena"}], 
   TextureCoordinateFunction -> ({#5, -#4} &), PlotPoints -> 2, Mesh -> None
]

Graphics3D[
 { Sphere[{0, 0, 0}, .99],
   image,
   GeometricTransformation[ image, RotationTransform[{{1, 0, 0}, {1, 1, 1}}]],
   GeometricTransformation[ 
     image /. _Texture -> Texture[ExampleData[{"TestImage", "Airplane"}]],
     RotationTransform[{{1, 0, 0}, {1, -1, 1}}]
   ]
 }
 ]

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.