# How to rotate a lattice points about an arbitrary axis

I have

hexpoints =
Table[{Cos[n Pi/3] + 1, Sin[n Pi/3] + \[Sqrt]3/2}, {n, 6}];


Which gives the fundamental cell to be applied in

ptss[x_, y_] :=
Flatten[Table[{{3 m, \[Sqrt]3 n}, {3 m +
3/2, \[Sqrt]3 n + \[Sqrt]3/2}}, {m, 0, x}, {n, 0, y}], 2]


by a transformation

hexlattice =
TranslationTransform[# - hexpoints[[1]]][hexpoints] & /@ ptss[1, 1];


In this case is a set of points

{{{0, 0}, {-1, 0}, {-(3/2), -(Sqrt[3]/2)}, {-1, -Sqrt[3]}, {0, -Sqrt[3]}, ...


ListPlot of them

How could I rotate these points, by an arbitrary axis and angle?

• Have you had a chance to check out RotationTransform? Commented Sep 27, 2019 at 4:12
• Yes, I've tried to use that, but with no success (in hexpointss = Table[{Cos[n Pi/3] + 1, Sin[n Pi/3] + [Sqrt]3/2}, {n, 6}]) Commented Sep 27, 2019 at 4:20

hexlattice = Join @@ (TranslationTransform[# - hexpoints[[1]]][hexpoints] & /@ ptss[1, 1]);

Manipulate[Graphics[{Gray, PointSize[Medium], Point[hexlattice],
Red, Rotate[Point @ #, θ, x] & /@ hexlattice},
PlotRange -> {{-10, 10}, {-10, 10}}, GridLines -> (List /@ x)],
{θ, 0, 2 Pi, ExperimentalAngularSlider[##] &},
{{x, {0, 0}}, Locator}]


Using Graph to connect points to their translations:

ClearAll[colors]
colors[t_, x_][p_] := p /. Thread[Range[2 Length @ hexlattice] ->
Join[#, #] & @(ColorData["Rainbow"] /@ Rescale[Range[Length @ hexlattice]])];

Manipulate[Graph[DirectedEdge[#, # + Length @ hexlattice] & /@ Range[Length @ hexlattice],
VertexSize -> {_ -> Scaled[.02],
(Alternatives @@ Range[Length @ hexlattice]) -> Scaled[.015]},
EdgeStyle -> {DirectedEdge[a_, b_] :>
VertexStyle -> {v_ :> colors[θ, x][v]},
(RotationTransform[θ, x] /@ hexlattice)]],
PlotRange -> {{-10, 10}, {-10, 10}},
GridLines -> (List /@ x)],
{{θ, Pi/2}, 0, 2 Pi, ExperimentalAngularSlider[##] &},
{{x, {-2, -3}}, Locator}]


• That angular slider is awesome. I'm going to get some use out of that! Commented Sep 27, 2019 at 15:44
• @MassDefect, you might find NotebookToolsAngularSliderTest[] useful.
– kglr
Commented Sep 27, 2019 at 15:46

My take.

rotate = RotationTransform[Pi/12, {2.5, 1}];

Show[
ListPlot[hexlattice],
ListPlot[rotate /@ hexlattice],
Epilog -> ({Dashed, Blue, Opacity[0.6], Arrowheads[Small],
Arrow[#]} & /@
Transpose[{Flatten[hexlattice, 1],
Flatten[rotate /@ hexlattice, 1]}]),
PlotRange -> All]


First, define the axis and the angle, then translate all points so that the origin is now your axis. After that rotate using the rotation matrix and put the origin back as it was. This can be summed up as

$$\vec{x}_{new} = R(\theta) \cdot (\vec{x}_{old} - \vec{x}_{axis}) + \vec{x}_{axis}$$

axis = {1, 1};
angle = π/20;
rotatedhexlattice =
Table[RotationMatrix[angle].(point - axis) + axis, {point,Flatten[hexlattice, 1]}]


Note, that I used Flatten because of the structure of hexlattice`.

This produces the following listplot:

Gray points are the old ones, orange "x" is the center and red points are the rotated ones.

• If I use pts[a,b] with a>b or b>a. The lattice become deformated, you know why? Commented Sep 28, 2019 at 7:14