Message Boards Message Boards

GROUPS:

[GIF] Cross Sections (Slices of the cuboctahedron)

Posted 10 months ago
2167 Views
|
2 Replies
|
13 Total Likes
|

Slices of the cuboctahedron

Cross Sections

A classic @beesandbombs-style foreground/background mixup, this time with slices of the cuboctahedron in a chessboard pattern.

To define this, first we need a function I wrote more than five years ago (to make Quarter Turn) giving horizontal slices of the cuboctahedron (whose vertices I found using PolyhedronData["Cuboctahedron", "VertexCoordinates"]):

cubocta[t_] := Flatten[
   If[t < 1/2,
    Table[
     {(1 - 2 t) 1/2 {Cos[\[Theta]], Sin[\[Theta]]} + 2 t/Sqrt[2] {Cos[\[Theta] + \[Pi]/4], Sin[\[Theta] + \[Pi]/4]},
      (1 - 2 t) 1/2 {Cos[\[Theta]], Sin[\[Theta]]} + 2 t/Sqrt[2] {Cos[\[Theta] - \[Pi]/4], Sin[\[Theta] - \[Pi]/4]}},
     {\[Theta], \[Pi]/4, -2 \[Pi] + \[Pi]/2, -\[Pi]/2}],
    Table[
     {(1 - 2 (t - 1/2)) 1/Sqrt[2] {Cos[\[Theta] + \[Pi]/4], Sin[\[Theta] + \[Pi]/4]} + 2 (t - 1/2)/2 {Cos[\[Theta]], Sin[\[Theta]]},
      (1 - 2 (t - 1/2)) 1/Sqrt[2] {Cos[\[Theta] - \[Pi]/4], Sin[\[Theta] - \[Pi]/4]} + 2 (t - 1/2)/2 {Cos[\[Theta]], Sin[\[Theta]]}},
     {\[Theta], \[Pi]/4, -2 \[Pi] + \[Pi]/2, -\[Pi]/2}]],
   1];

We also need the trusty smootheststep function:

smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;

So now here's a Manipulate of the first half:

DynamicModule[{t, cols = RGBColor /@ {"#fdb827", "#21209c"}},
 Manipulate[
  t = smootheststep[s];
  Graphics[
   {cols[[-1]],
    Table[
     Polygon[
      TranslationTransform[{x, y}][
       RotationTransform[3 \[Pi]/4 t][
        (Sqrt[2] (1 - t) + t) cubocta[t/2]]]],
     {x, -6, 6, 2}, {y, -6, 6, 2}],
    Table[
     Polygon[
      TranslationTransform[{x, y}][
       RotationTransform[3 \[Pi]/4 t][
        (Sqrt[2] (1 - t) + t) cubocta[t/2]]]],
     {x, -5, 5, 2}, {y, -5, 5, 2}]},
   PlotRange -> {{-4.5, 3.5}, {-4.5, 3.5}}, Background -> cols[[1]], 
   ImageSize -> 540, PlotRangePadding -> -.01],
  {s, 0, 1}]
 ]

And the second half:

DynamicModule[{t, cols = RGBColor /@ {"#fdb827", "#21209c"}},
 Manipulate[
  t = smootheststep[s];
  Graphics[
   {cols[[1]],
    Table[
     Polygon[
      TranslationTransform[{x, y}][
       RotationTransform[\[Pi]/4 - 3 \[Pi]/4 t][
        (Sqrt[2] t + (1 - t)) cubocta[t/2 + 1/2]]]],
     {x, -5, 5, 2}, {y, -6, 6, 2}],
    Table[
     Polygon[
      TranslationTransform[{x, y}][
       RotationTransform[\[Pi]/4 - 3 \[Pi]/4 t][
        (Sqrt[2] t + (1 - t)) cubocta[t/2 + 1/2]]]],
     {x, -6, 6, 2}, {y, -5, 5, 2}]},
   PlotRange -> {{-4.5, 3.5}, {-4.5, 3.5}}, Background -> cols[[-1]], 
   ImageSize -> 540, PlotRangePadding -> -.01],
  {s, 0, 1}]
 ]
2 Replies

Very satisfying to watch! Thanks for sharing!

enter image description here -- you have earned Featured Contributor Badge enter image description here Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract