Improving my superimposed hexagonal lattice code

Question

Pretty knew to Mathematica here. I have created a code stemming from a basic function that I found here in the stack exchange. I am basically making three different hexagonal lattices. Two of them are rotated with respect to the [un]-rotated one. There are two different angles of rotation, but what they are is not relevant. My code is the following:

\[Theta]tm = 5;
\[Theta]mb = -5;

unitcell[x_, y_] := {Black, Disk[{x, y}, 0.05], Black, 
  Disk[{x, y + 2/3 Sin[120 Degree]}, 0.05],
  , Black, Line[{{x, y}, {x, y + 2/3 Sin[120 Degree]}}], 
  Line[{{x, y}, {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}], 
  Line[{{x, y}, {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}]}

Rtm[\[Theta]_] = {{Cos[\[Theta]*Pi/360.], -Sin[\[Theta]*Pi/360.]},
   {Sin[\[Theta]*Pi/360.], Cos[\[Theta]*Pi/360.]}};

topmoire[x_, y_] := {Red, Disk[Rtm[\[Theta]tm] . {x, y}, 0.05], Red, 
  Disk[Rtm[\[Theta]tm] . {x, y + 2/3 Sin[120 Degree]}, 0.05],
  , Red, Line[{Rtm[\[Theta]tm] . {x, y}, 
    Rtm[\[Theta]tm] . {x, y + 2/3 Sin[120 Degree]}}], 
  Line[{Rtm[\[Theta]tm] . {x, y}, 
    Rtm[\[Theta]tm] . {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}], 
  Line[{Rtm[\[Theta]tm] . {x, y}, 
    Rtm[\[Theta]tm] . {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}]}

Rmb[\[Theta]_] = {{Cos[\[Theta]*Pi/360.], -Sin[\[Theta]*Pi/360.]},
   {Sin[\[Theta]*Pi/360.], Cos[\[Theta]*Pi/360.]}};

bottommoire[x_, y_] := {Green, Disk[Rtm[\[Theta]mb] . {x, y}, 0.05], 
  Green, Disk[Rtm[\[Theta]mb] . {x, y + 2/3 Sin[120 Degree]}, 0.05],
  , Green, 
  Line[{Rtm[\[Theta]mb] . {x, y}, 
    Rtm[\[Theta]mb] . {x, y + 2/3 Sin[120 Degree]}}], 
  Line[{Rtm[\[Theta]mb] . {x, y}, 
    Rtm[\[Theta]mb] . {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}], 
  Line[{Rtm[\[Theta]mb] . {x, y}, 
    Rtm[\[Theta]mb] . {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}]}

middle = Graphics[
   Block[{A = {Cos[120 Degree], Sin[120 Degree]}, B = {1, 0}, 
     C = {-1, 0}}, 
    Table[unitcell @@ (A j + B k + C l), {j, -20, 20}, {k, 
      Ceiling[j/2], 20 + Ceiling[j/2]}, {l, Ceiling[j/2], 
      20 + Ceiling[j/2]}]], ImageSize -> 500];

top = Graphics[
   Block[{A = {Cos[120 Degree], Sin[120 Degree]}, B = {1, 0}, 
     C = {-1, 0}}, 
    Table[topmoire @@ (A j + B k + C l), {j, -20, 20}, {k, 
      Ceiling[j/2], 20 + Ceiling[j/2]}, {l, Ceiling[j/2], 
      20 + Ceiling[j/2]}]], ImageSize -> 500];

bottom = Graphics[
   Block[{A = {Cos[120 Degree], Sin[120 Degree]}, B = {1, 0}, 
     C = {-1, 0}}, 
    Table[bottommoire @@ (A j + B k + C l), {j, -20, 20}, {k, 
      Ceiling[j/2], 20 + Ceiling[j/2]}, {l, Ceiling[j/2], 
      20 + Ceiling[j/2]}]], ImageSize -> 500];

Show[top, middle, bottom]

I was having trouble superimposing the three lattices on top of each other. For this I used

Show[top,middle,bottom]

However, in order to center the lattices at the origin, I had to introduce another vector within the function Table, the vector "C" multiplied by "l". I think this has made my code crash everytime I try to run it. Is there another efficient way to either center the lattices on the origin of rotation with only two vectors, or perhaps a replacement of the Table function?

Also, while this is not urgent, and not as important. I would like to know how to generalize this code in order to depend on a position argument, i.e. "r" where I can tweak how big (unit of length) I want the lattice to be (in x and y directions).

Answer 1

I'm gonna be honest here, I didn't even try to understand your code. It seems that it produces a lot of unnessecary duplicate data I think.

I implemented a Grid from scratch which can only generate a non-rotated grid:

TriAngle[{x_,y_},leftMost_,topMost_]:={
Line[{{x,y},{x,y}+{Sin[Pi],Cos[Pi]}}],
Line[{{x,y},{x,y}+{Sin[Pi+2/3Pi],Cos[Pi+2/3Pi]}}],
Line[{{x,y},{x,y}+{Sin[Pi+4/3Pi],Cos[Pi+4/3Pi]}}],
If[leftMost,Line[{{x,y}+{Sin[Pi+2/3Pi],Cos[Pi+2/3Pi]},{x,y}+{Sin[Pi+2/3Pi],Cos[Pi+2/3Pi]}-{Sin[Pi+4/3Pi],Cos[Pi+4/3*Pi]}}],Nothing],
If[topMost,Line[{{x,y}+{Sin[Pi+4/3Pi],Cos[Pi+4/3Pi]},{x,y}+{Sin[Pi+4/3Pi],Cos[Pi+4/3Pi]}+{0,1}}],Nothing]
}

LatticePattern[xN_,yN_]:=Flatten[Table[TriAngle[{Cos[Pi/6]*x*2.0-Cos[Pi/6]*y,y+Sin[Pi/6]*y},x==Floor[-xN/2]&&y!=Floor[yN/2],y==Floor[yN/2]&&x!=Floor[xN/2]],{x,Floor[-xN/2],Floor[xN/2]},{y,Floor[-yN/2],Floor[yN/2]}]]

This creates all the Line primitives for your grid. So for example:

Graphics[LatticePattern[10, 10]]

Equipped with that, I just made two copies and used GeometricTransformationto apply the rotations.

\[Theta]p=5;
\[Theta]m=-5;
p1=LatticePattern[30,30];
p2=GeometricTransformation [p1,RotationTransform[\[Theta]p*\[Degree],{0,0}]];
p3=GeometricTransformation [p1,RotationTransform[\[Theta]m*\[Degree],{0,0}]];
Graphics[{Black,p1,Red,p2,Green,p3}//Flatten,ImageSize->800]

I hope this helps.

EDIT: Oh this is fun:

p1=LatticePattern[20,20,0.0];
Graphics[Flatten[Table[{Hue[phi/Pi],GeometricTransformation[p1,RotationTransform[phi,{0,0}]]},{phi,0,Pi,Pi/20}]],ImageSize->800]