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.

cvgmt · Accepted Answer · 2023-08-06T07:30:48.457

This is the process of reconstructing the polyhedron Icosahedron.

Clear["Global`*"];
img = Import["https://i.stack.imgur.com/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.stack.imgur.com/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}]

wow ,Thank you, very grateful for the detail to create the image, could you join the corresponding points and animate the corresponding body around the three axes in 360° cycles and export the results to an animated gif — Pamela, Aug 06 '23 at 05:18
@cvgnt, Thank you very much for your effort, ah, it turned out great, so much so that I want to ask you one more favor, in the plans you can include text that says "Second Mathematical Olympiad", there you seal it with a platinum clasp — Pamela, Aug 06 '23 at 16:38
I hope you are encouraged by the last thing I wrote to you, I would appreciate it — Pamela, Aug 07 '23 at 16:10
@Pamela I have try, but the Second Mathematical Olympiad is too long to put onto the rectangles. Or if I scaling the fonts, the fonts too small to see. — cvgmt, Aug 08 '23 at 03:13

kglr · Answer 2 · 2023-08-06T20:42:37.917

10

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]

edited Aug 06 '23 at 20:42

answered Aug 06 '23 at 02:18

kglr

394,356
18
477
896

:) :) Thanks, impressive for the shortness of the code, you could animate it in 360° cycles, for the three axes and export the animation to a gif – Pamela Aug 06 '23 at 05:13
hi , It also turned out great, although I had problems with rotate some bug, "Rotate is not a primitive or directive of Graphics3D. ", my MMA version is 13.0.1. Could you, if possible, include text on the cloths that says "Second Mathematical Olympiad", I would be very grateful. – Pamela Aug 06 '23 at 17:07

Bob Hanlon · Answer 3 · 2023-08-06T06:06:08.053

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.stack.imgur.com/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];

wow ; Thanks, since you put three angles, it would be possible to produce 360° movements for each angle and the movements to store them in an animated gif, thanks in advance — Pamela, Aug 06 '23 at 05:10
I was visualizing your animation and it sticks a few jumps, apparently the border of the planes is annoying there, the color blur that you put on it is important, you can fix the animation so that it only comes out with the animated body, thanks for your effort, I learn a lot from you. — Pamela, Aug 06 '23 at 17:20
If you don't want the controls use Table instead of Animate — Bob Hanlon, Aug 06 '23 at 18:16

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

3 Answers3

Linked