How can I draw this image and if you can make it rotate horizontally and vertically?

Question

I've been looking at the site, but it doesn't occur to me there was a method to obtain the coordinates of the image, but I can't find it. Could you give me a hand?

It's for a poster of the Mathematical Olympics that my son's teacher asked me for once he saw me doing things with Mathematica. It is understood that it is the 3D image, people do not.

Answer 1

This is the process of reconstructing the polyhedron Icosahedron.

Clear["Global`*"];
img = Import["https://i.sstatic.net/FAbVi.png"];
colors = DominantColors[img]
c = 1/2 (1 + Sqrt[5]);
p1 = {1, -c, 0};
p2 = {0, -1, c};
p3 = {-1, -c, 0};
xy = {{1, c, 0}, {-1, c, 0}, {-1, -c, 0}, {1, -c, 0}};
yz = {{0, 1, c}, {0, -1, c}, {0, -1, -c}, {0, 1, -c}};
zx = {{c, 0, 1}, {c, 0, -1}, {-c, 0, -1}, {-c, 0, 1}};
g=Graphics3D[{AbsolutePointSize[8], Point /@ {xy, yz, zx}, colors[[5]], 
  Polygon[xy], colors[[4]], Polygon[yz], colors[[3]], Polygon[zx], 
  Red, AbsolutePointSize[12], Point[{p1, p2, p3}]}, 
 Lighting -> {{"Ambient", White}}]

Where the c come from the equation.

Clear[p1, p2, p3, c];
p1 = {1, -c, 0};
p2 = {0, -1, c};
p3 = {-1, -c, 0};
Solve[{EuclideanDistance[p1, p2] == EuclideanDistance[p1, p3], c > 0},
  c]

• Animation

img = Import["https://i.sstatic.net/FAbVi.png"];
colors = DominantColors[img];
c = 1/2 (1 + Sqrt[5]);
xy = {{1, c, 0}, {-1, c, 0}, {-1, -c, 0}, {1, -c, 0}};
yz = {{0, 1, c}, {0, -1, c}, {0, -1, -c}, {0, 1, -c}};
zx = {{c, 0, 1}, {c, 0, -1}, {-c, 0, -1}, {-c, 0, 1}};
options = {Boxed -> False, SphericalRegion -> True, 
   Lighting -> {{"Ambient", White}}};
g = Graphics3D[{AbsolutePointSize[8], Point /@ {xy, yz, zx}, 
    colors[[5]], Polygon[xy], colors[[4]], Polygon[yz], colors[[3]], 
    Polygon[zx], EdgeForm[Thick], FaceForm[], 
    ConvexHullMesh@Catenate[{xy, yz, zx}]}, options];
rotZ = Table[
   Graphics3D[
    GeometricTransformation[First@g, RotationTransform[t, {0, 0, 1}]],
     options], {t, 0, 2 π, .2}];
rotY = Table[
   Graphics3D[
    GeometricTransformation[First@g, RotationTransform[t, {0, 1, 0}]],
     options], {t, 0, 2 π, .2}];
rotX = Table[
   Graphics3D[
    GeometricTransformation[First@g, RotationTransform[t, {1, 0, 0}]],
     options], {t, 0, 2 π, .2}];
ListAnimate[Catenate[{rotZ, rotY, rotX}], AnimationRate -> 5]
Export["rotation.gif", Catenate[{rotZ, rotY, rotX}]]

• Another way to construct yz and zx by cyclic the coordinate.

Clear[c, xy, yz, zx];
c = 1/2 (1 + Sqrt[5]);
xy = {{1, c, 0}, {-1, c, 0}, {-1, -c, 0}, {1, -c, 0}};
yz = RotateRight /@ xy;
zx = RotateRight /@ yz;
Graphics3D[Polygon /@ {xy, yz, zx}]

Answer 2

cp = Map[Prepend[0]] @ Delete[{{3}, {6}}] @ CirclePoints[{1, Pi/3}, 6] ;

coords = Table[Map[RotateRight[#, i] &] @ cp, {i, 3}];

colors = {RGBColor[1, .5, .5], RGBColor[1, 1, .5], RGBColor[.5, 1, .5]};

show = Show[Graphics3D @
   Thread[{colors, Lighting -> {{"Ambient", White}}, Polygon /@ coords}],
 MeshConnectivityGraph @ ConvexHullRegion[Join @@ coords], 
 SphericalRegion -> True, Boxed -> False]

rotate[angle_, axis_] := MapAt[Rotate[#, angle, UnitVector[3, axis]] &, {1}]

Manipulate[rotate[θ, axis] @ show,
 {{axis, 1, "axis" }, Thread[Range @ 3 -> {"X", "Y", "Z"}]}, 
 {{θ, 0, "angle"}, 0, 2 π, Appearance -> "Open"}]

Animation above created using:

frames = Join @@ Table[rotate[2 Pi t, a] @ show, {a, 1, 3, 1}, {t, 0, 1, 1/25}]

Export["rotations.gif", frames]

Answer 3

Building on cvgmt's answer

$Version

(* "13.3.0 for Mac OS X ARM (64-bit) (June 3, 2023)" *)

Clear["Global`*"];

img = Import["https://i.sstatic.net/FAbVi.png"];

colors = DominantColors[img];

c = 1/2 (1 + Sqrt[5]);
z = {{c, 1, 0}, {-c, 1, 0}, {-c, -1, 0}, {c, -1, 0}};
x = {{0, c, 1}, {0, -c, 1}, {0, -c, -1}, {0, c, -1}};
y = {{1, 0, c}, {1, 0, -c}, {-1, 0, -c}, {-1, 0, c}};

Manipulate[
 f = GeometricTransformation[#,
    RollPitchYawMatrix[{α, β, γ}]] &;
 Graphics3D[{
   Opacity[0.1], EdgeForm[AbsoluteThickness[1.5]],
   f@Icosahedron[{0, -3 Pi/16}, 2],
   Opacity[1], EdgeForm[],
   colors[[3]], f@Polygon[x],
   colors[[4]], f@Polygon[y],
   colors[[5]], f@Polygon[z]}, Lighting -> {{"Ambient", White}},
  Boxed -> False],
 {{α, 7 Pi/16}, -Pi/2, Pi/2, Pi/64, Appearance -> "Labeled"},
 {{β, 0}, -Pi/2, Pi/2, Pi/64, Appearance -> "Labeled"},
 {{γ, 0}, -Pi/2, Pi/2, Pi/64, Appearance -> "Labeled"},
 SynchronousUpdating -> False,
 TrackedSymbols :> {α, β, γ}]

EDIT: To export an animated GIF

animation = Animate[
  f = GeometricTransformation[#,
     RollPitchYawMatrix[{α, β, γ}]] &;
  Graphics3D[{
    Opacity[0.1], EdgeForm[AbsoluteThickness[1.5]],
    f@Icosahedron[{0, -3 Pi/16}, 2],
    Opacity[1], EdgeForm[],
    f@Polygon[x, VertexColors ->
       {Pink, White, Pink, White}],
    colors[[4]], f@Polygon[y, VertexColors ->
       {Yellow, White, Yellow, White}],
    f@Polygon[z, VertexColors ->
       {Green, White, Green, White}]},
   Lighting -> {{"Ambient", White}},
   Boxed -> False],
  {{α, -Pi}, -Pi, Pi, Pi/16},
  {{β, -Pi}, -Pi, Pi, Pi/16},
  {{γ, -Pi}, -Pi, Pi, Pi/16},
  AnimationRepetitions -> 1]

Export["/Users/roberthanlon/Downloads/animation.gif", animation];