4
$\begingroup$

In the field of architecture, learning to manipulate geometry so comprehensively with Mathematica has been fun. However, I seem to have reached my limits with the following GeometricTransformation of panels generated with the following code: 

poly=Module[{div=6,len=16000,list,sqx,sqy,h=Table[{1+c,2+c,9+c,8+c},{c,0,40}],listy,listx},
list=Flatten[Table[{x,y,z},{x,0,len,len/div},{y,0,len,len/div},{z,0,len,len/div}],2];
sqy=Select[list,#[[1]]==0&];
sqx=Select[list,#[[2]]==0&];
listy=Drop[Part[sqy,#] &/@ h,{7,40,7}];
listx=Drop[Part[sqx,#] &/@ h,{7,40,7}];
Polygon/@ Join[listx,listy]];

panels

What I'm trying to do next is to rotate each individual panel by some controllable degree, but instead the whole thing moves as one:

Graphics3D[GeometricTransformation[#, RotationMatrix[-Pi/8,{1,0,0}]] &/@ poly]

rotate panel

I've tried using RegionBounds to somehow create a vector axis to rotate each individual panel around, but seem to get stuck in 1) creating the vector and 2) feeding each panel's rotation vector back into GeometricTransform. Eventually I'd like to randomize the direction of the opening and generalize the function for any division of the surface but it's time to ask for help. Thanks.

Update: It occurred to me that I could include an image of the building to show the final geometry we are aiming for. (Here presented under a CC license credit:PeterBarr) building

Update 18-03-18

Taking the below suggestions as a starting point, I've decided to 1) angle the plane outward and 2) randomly select one of the 4 edges to use as an axis in one step. I've worked out the geometry of such an approach which needs to take into account which vertex of the plane is randomly selected to then assign the correct vector direction. I should be able to develop a list to feed into the RotationTransform however when trying to execute my RandomChoice function, only the geometry of the first polygon is used 10 times. Very strange. Any suggestions?

x1={{0,0,1},#[[1,1]]};x2={{1,0,0},#[[1,2]]};x3={{0,0,-1},#[[1,3]]};x4={{-1,0,0},#[[1,4]]};
RandomChoice[{v1,v2,v3,v4}] &/@ poly[[;;]]

Final Update 18-03-21

After a little reverse engineering I got exactly what I wanted. Thanks for the help. 

panel[f_]:=Module[{f1,f2,, \[Theta] = -Pi/5},
f1 =MakePolygons[Table[N[{x, 0, z}], {x, 0, f}, {z, 0, f}]];
f2=MakePolygons[Table[N[{0, y, z}], {y, 0, f}, {z, 0, f}]];
Table[Graphics3D[{spinPanel2[#, RandomInteger[{1, 4}], \[Theta]] &/@ f1,
spinPanel2[#, RandomInteger[{1, 4}], \[Theta]] &/@ f2}, 
ImageSize-> Small,Boxed->False,Lighting->"Neutral",ViewPoint->n],{n,{Front,{1,-2,2},{2,-3,2},{-5,1,2}}}]]

enter image description here

Improve this question
$\endgroup$
6
  • $\begingroup$ You want to be able to rotate the two panels independently? $\endgroup$
    – J. M.'s torpor ♦
    Mar 14 '18 at 5:09
  • $\begingroup$ I want to try to control all the divided panels independently. I've updated the original question with more info and will try to run through the suggested solutions later tonight. $\endgroup$
    – BBirdsell
    Mar 14 '18 at 15:06
  • $\begingroup$ Wait... so are you envisioning $6\times 6\times 2$ rotation controls in your example, one for each panel? $\endgroup$
    – J. M.'s torpor ♦
    Mar 15 '18 at 1:40
  • $\begingroup$ I want to apply the same rotation to each individual panel instead of having the whole surface rotate as one. Then I will try to randomize the rotation. I'm having trouble finding the vector of each panel to rotate around. Tho @kglr's information was helpful and appricated. $\endgroup$
    – BBirdsell
    Mar 15 '18 at 5:22
  • $\begingroup$ "which needs to take into account which vertex of the plane is randomly selected " - why not pick edges instead of picking corners, just like what kglr and I are doing? The rotation going in a desired direction will now depend on whether the vertices are oriented clockwise or anticlockwise when facing you. $\endgroup$
    – J. M.'s torpor ♦
    Mar 19 '18 at 1:42
5
$\begingroup$

Let me offer a toy for you to play with:

MakePolygons[vl_] /; ArrayQ[vl, 3] := 
    Flatten[Apply[Polygon[Join[Reverse[#1], #2]] &, 
                  Partition[vl, {2, 2}, {1, 1}], {2}]]

spinPanel[Polygon[pts_?MatrixQ], α_, β_, γ_] := With[{cent = Mean[pts]}, 
    Polygon[AffineTransform[{RollPitchYawMatrix[{α, β, γ}], cent}]
            [TranslationTransform[-cent][pts]]]]

DynamicModule[{p = 6, q = 6, α1 = 0, β1 = 0, γ1 = 0, α2 = 0, β2 = 0, γ2 = 0},
              Panel[Row[{Column[{
                    Row[{"Width: ", Slider[Dynamic[p], {2, 10, 1}]}], 
                    Row[{"Height: ", Slider[Dynamic[q], {2, 10, 1}]}], 
                    Graphics3D[{Dynamic[spinPanel[#, α1, β1, γ1] & /@ 
                                MakePolygons[Table[N[{x, 0, z}],
                                                   {x, 0, p}, {z, 0, q}]], 
                                TrackedSymbols :> {p, q, α1, β1, γ1}], 
                                Dynamic[spinPanel[#, α2, β2, γ2] & /@ 
                                MakePolygons[Table[N[{0, y, z}],
                                                   {y, 0, p}, {z, 0, q}]], 
                                TrackedSymbols :> {p, q, α2, β2, γ2}]}, 
                               ImageSize -> Scaled[3/8]]}], Spacer[10], 
                    Grid[{{"", "Panel 1", "Panel 2"},
                          {"Pitch", Experimental`AngularSlider[Dynamic[γ1]],
                                    Experimental`AngularSlider[Dynamic[γ2]]},
                          {"Roll", Experimental`AngularSlider[Dynamic[β1]],
                                   Experimental`AngularSlider[Dynamic[β2]]},
                          {"Yaw", Experimental`AngularSlider[Dynamic[α1]],
                                  Experimental`AngularSlider[Dynamic[α2]]}}]}]]]

rotatable panels

Here's the version where the panels swivel by their hinges:

spinPanel2[Polygon[pts_?MatrixQ], k : (1 | 2 | 3 | 4), θ_] := 
    With[{axis = {pts[[k]], pts[[Mod[k + 1, 4, 1]]]}}, 
         Polygon[RotationTransform[θ, axis[[2]] - axis[[1]], axis[[1]]][pts]]]

DynamicModule[{p = 6, q = 6, k1 = 1, k2 = 1, θ1 = 0, θ2 = 0}, 
              Panel[Row[{Column[{Row[{"Width: ", Slider[Dynamic[p], {2, 10, 1}]}], 
                                 Row[{"Height: ", Slider[Dynamic[q], {2, 10, 1}]}], 
                                 Graphics3D[{Dynamic[spinPanel2[#, k1, θ1] & /@ 
                                             MakePolygons[Table[N[{x, 0, z}],
                                                                {x, 0, p}, {z, 0, q}]], 
                                             TrackedSymbols :> {p, q, k1, θ1}], 
                                             Dynamic[spinPanel2[#, k2, -θ2] & /@ 
                                             MakePolygons[Table[N[{0, y, z}],
                                                                {y, 0, p}, {z, 0, q}]], 
                                             TrackedSymbols :> {p, q, k2, θ2}]}, 
                                            ImageSize -> Scaled[3/8], 
                                            PlotRange -> {{-1, p}, {-1, p}, {0, q}}]}],
                         Spacer[10], 
                         Grid[{{"Panel 1", "Panel 2"},
                               {SetterBar[Dynamic[k1],
                                {4 -> "Top", 2 -> "Bottom", 1 -> "Left", 3 -> "Right"}], 
                                SetterBar[Dynamic[k2],
                                {4 -> "Top", 2 -> "Bottom", 3 -> "Left", 1 -> "Right"}]},
                               {Experimental`AngularSlider[Dynamic[θ1]], 
                                Experimental`AngularSlider[Dynamic[θ2]]}}]}]]]

hinged panels

Using the same idea, plus a little randomization:

BlockRandom[SeedRandom[1464]; (* for reproducibility *)
            With[{p = 6, q = 6},
                 Module[{f1, f2},
                        f1 = MakePolygons[Table[N[{x, 0, z}], {x, 0, p}, {z, 0, q}]];
                        f2 = MakePolygons[Table[N[{0, y, z}], {y, 0, p}, {z, 0, q}]];
                        Graphics3D[{{FaceForm[],
                                     EdgeForm[Directive[GrayLevel[2/3],
                                                        AbsoluteThickness[4]]],
                                     f1, f2},
                                    {EdgeForm[GrayLevel[3/4]],
                                     {FaceForm[Opacity[3/4,
                                               ColorData["Legacy", "AliceBlue"]], Gray], 
                                      spinPanel2[#, RandomInteger[{1, 4}],
                                                 RandomReal[π/4]] & /@ f1},
                                     {FaceForm[Gray, 
                                               Opacity[3/4,
                                               ColorData["Legacy", "AliceBlue"]]],
                                      spinPanel2[#, RandomInteger[{1, 4}],
                                                 -RandomReal[π/4]] & /@ f2}}},
                                   Boxed -> False, Lighting -> "Neutral"]]]]

randomly opened panels

Improve this answer
$\endgroup$
2
  • $\begingroup$ This is pretty epic! I can barely read it considering my coding level. Making the polygons by arrays is straightforward, but I've never even heard of functions like RollPitchYawMatrix. Nicely done. I can at least appricate it. $\endgroup$
    – BBirdsell
    Mar 17 '18 at 1:52
  • $\begingroup$ Now that I look at it, my solution pivots the panels around their centers (that's what the cent = Mean[pts] in spinPanel[] was for), but you seem to want to be able to rotate around the four possible sides. I'll edit this solution later, but it should be a straightforward (albeit tedious) conversion. $\endgroup$
    – J. M.'s torpor ♦
    Mar 17 '18 at 2:00
8
$\begingroup$ 
t1 = -Pi/8; v1 = {1, 0, 0};
t2 = -Pi/4; v2 = {0, 1, 0};
Graphics3D[{GeometricTransformation[#, RotationMatrix[t1, v1]] & /@ poly[[;; 36]], 
  GeometricTransformation[#, RotationMatrix[t2, v2]] & /@  poly[[37 ;;]]}, Axes -> True]

enter image description here

Rotate each polygon independently:

Graphics3D[{Hue[RandomReal[]], GeometricTransformation[#, 
     RotationMatrix[RandomReal[{-Pi/6, Pi/6}], 
      Mean@RandomChoice[Partition[#[[1]], 2, 1, 1]]]]} & /@ poly, 
 Boxed -> False, Lighting -> "Neutral"]

enter image description here

Update: Swiveling each polygon around randomly selected side using RotationTransform:

Graphics3D[{EdgeForm[], Opacity[.5, Yellow], poly, 
 {Opacity[1], EdgeForm[Gray], Hue[RandomReal[]], 
  GeometricTransformation[#, RotationTransform[RandomReal[{-Pi/6, Pi/6}], 
  RandomChoice[{{1, 0, 0}, {0, 0, 1}}], RandomChoice[#[[1, {2, 4}]]]]]}&/@ poly[[;; 36]], 
 {Opacity[1], EdgeForm[Gray], Hue[RandomReal[]], 
  GeometricTransformation[#, RotationTransform[RandomReal[{-Pi/6, Pi/6}], 
  RandomChoice[{{0, 1, 0}, {0, 0, 1}}], RandomChoice[#[[1, {2, 4}]]]]]}&/@ poly[[37 ;;]]},
 Boxed -> False, Lighting -> "Neutral"]

or, more compactly,

Graphics3D[{EdgeForm[], Opacity[.5, Yellow], poly,
  {Opacity[1], EdgeForm[Gray], Hue[RandomReal[]], 
     GeometricTransformation[#, RotationTransform[RandomReal[{-Pi/6, Pi/6}], 
       RandomChoice[{If[Total@#[[1, All, 2]] == 0, {1, 0, 0}, {0, 1, 0}], {0, 0, 1}}], 
       RandomChoice[#[[1, {2, 4}]]]]]} & /@ poly}, 
 Boxed -> False, Lighting -> "Neutral"]

enter image description here

Another view:

enter image description here

You can also use post-processing

Show[Graphics3D[{EdgeForm[], Opacity[.5, Yellow], poly}], 
 Graphics3D[poly] /. Polygon[x_] :> {EdgeForm[Gray], Hue[RandomReal[]], 
    GeometricTransformation[Polygon[x], RotationTransform[RandomReal[{-Pi/6, Pi/6}], 
      RandomChoice[{If[Total@x[[All, 2]] == 0, {1, 0, 0}, {0, 1, 0}], {0, 0, 1}}], 
      RandomChoice[x[[{1, 4}]]]]]}, Boxed -> False, Lighting -> "Neutral"]

to get the same result.

Using RandomChoice[{0, Pi/2, Pi, 4/3 Pi, 2 Pi}] instead of RandomReal[{-Pi/6, Pi/6}] we get

enter image description here

Change RandomChoice[#[[1, {1, 4}]]] to Mean[#[[1]]] to to swivel around the center (Yellow is replaced with Gray below):

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ Trying this solution tonight I've improved but still missing something. What does the 4th option do in Partition[#[[1]], 2, 1, 1]? And what if I only wanted 4 random options? One up, down and each side? $\endgroup$
    – BBirdsell
    Mar 15 '18 at 5:21
  • $\begingroup$ @BBirdsell, re Partition, try Partition[{a,b,c}, 2,1] vs Partition[{a,b,c},2,1,1]. Re the "4 random options": if you want to use one of the 4 sides as the hinge, using RotationTransform may be more convenient as its three-argument form allows specification of an anchor. I will post an update when i get a chance. $\endgroup$
    – kglr
    Mar 15 '18 at 14:00
  • $\begingroup$ It's taken a while to reverse engineer your advanced use of Part to understand what's being selected. (MMA is pretty powerful in its abstraction). I'm stumbling now to have any 1 of the 4 polygon edges selected as the axis of rotation randomly, then a apply a contact rotation to that randomly selected edge. Progress is being made. $\endgroup$
    – BBirdsell
    Mar 17 '18 at 16:21

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.