7
$\begingroup$

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. enter image description here

$\endgroup$

2 Answers 2

12
$\begingroup$

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

Nanotube

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.

$\endgroup$
1
  • $\begingroup$ Thank you this is really helpful! $\endgroup$ Apr 14 at 22:56
8
$\begingroup$

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

enter image description here

enter image description here

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

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.