5
$\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$

1 Answer 1

2
$\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$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.