How to make a cylindrical lattice

Question

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.

Answer 1

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[
    {MapThread[Line[{#1,#2,#3}]&,{points[[1]],points[[2]],RotateLeft[points[[1]]]}]},
    Flatten[Table[{MapThread[Line[{#1,#2}]&,{points[[2+2i]],points[[2+2i+1]]}],MapThread[Line[{#1,#2,#3}]&,{points[[1+2i]],points[[1+2i+1]],RotateLeft[points[[1+2i]]]}]},{i,0,m-1}],1],
    {MapThread[Line[{#1,#2,#3}]&,{points[[-1]],points[[-2]],RotateLeft[points[[-1]]]}]}
  ];
  {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.

Answer 2

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}]