# How to make a cylindrical lattice

I'm writing a paper on graphene nanoribbons and was wondering what the best way to create a 3d graphic of the type below is. Creating the normal graphene lattice is simple but I'm not sure how i'd go about mapping it to a cylinder.

I am not sure about the exact geometry but this might be a starting point based on explicit computation of all nodes:

genHexTube[n_,m_,r_]:=Module[{rHex,tHex,theta,points,lines},
theta=2Pi/n;
rHex=1/2 Sqrt[2] Sqrt[(1-Cos[theta])]r;
tHex=2/Sqrt[3]*rHex;

points=Join[
{Table[r{Cos[x],Sin[x],0},{x,Subdivide[0,2Pi,n]}]},
Flatten[Array[With[{h=1.5tHex(#-1),thetaShift=0.5(#-1)theta},{Table[r{Cos[x+0.5theta+thetaShift],Sin[x+0.5theta+thetaShift],0.5*tHex+h},{x,Subdivide[0,2Pi,n]}],
Table[r{Cos[x+0.5theta+thetaShift],Sin[x+0.5theta+thetaShift],1.5*tHex+h},{x,Subdivide[0,2Pi,n]}]}]&,m],1],
With[{h=(1.5* m+0.5)tHex,thetaShift=(0.5m-0.5)theta},{Table[r{Cos[x+thetaShift],Sin[x+thetaShift],h},{x,Subdivide[0,2Pi,n]}]}]
];
lines=Join[
];
{points,lines}
]

genHexTube[12,6,1.0];
Sphere[#,0.05]&/@Flatten[%[[1]][[;;;;2]],1];
Sphere[#,0.05]&/@Flatten[%%[[1]][[2;;;;2]],1];
Graphics3D[{Green,Thick,%%%[[2]]/.Line[x_]:>Tube[x,0.01],Blue,%,Red,%%}]


resulting in

The lighting, the sphere and tube radii etc. could probably tweaked to get a more pleasing plot. I hope the geometry/placement of the atoms is correct but optically it seems fine. The code could also use some cleanup but for a proof of concept it should do I hope.

• Thank you this is really helpful! Commented Apr 14, 2022 at 22:56

We can mapping the plane hexagons to the cylinder.

n = 20;
m = 8;
c = 2 π/n;
e[1] = c*AngleVector[0];
e[2] = c*AngleVector[π/3];
pts = Tuples[{Range[n], Range[m]}] . {e[1], e[2]};
pts2d = CirclePoints[#, {c/(Sqrt[3]), π/2}, 6] & /@ pts;
Graphics[{{EdgeForm[Directive[Darker@Green, AbsoluteThickness[1]]],
FaceForm[],
Polygon /@ pts2d, {Blue, Point /@ pts2d[[All, {1, 3, 5}]]}, {Red,
Point /@ pts2d[[All, {2, 4, 6}]]}}}]

f[θ_, h_] = {Cos[θ], Sin[θ], h};
pts3d = Apply[f, pts2d, {2}];
Graphics3D[{{Blue, Ball[#, .04] & /@ pts3d[[All, {1, 3, 5}]]}, {Red,
Ball[#, .04] & /@ pts3d[[All, {2, 4, 6}]]}, {EdgeForm[
Directive[Darker@Green, AbsoluteThickness[2]]], FaceForm[],
Polygon /@ pts3d}}, Boxed -> False, PlotRange -> All,
ViewPoint -> {50, 10, 25}]


• ....(sighs) I need to wait two hours...Great solution!!!
– bmf
Commented Apr 14, 2022 at 21:40
• @bmf Thank you for your upvote! Commented Apr 14, 2022 at 21:52
• it's always a great pleasure when I see you posted an answer!
– bmf
Commented Apr 14, 2022 at 21:53