Hexagonal Close Packing

Author

Eric W. Weisstein
January 9, 2019

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/HexagonalClosePacking.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/HexagonalClosePacking.html.

©2019 Wolfram Research, Inc. except for portions noted otherwise

Unit cell

https://www.nde-ed.org/EducationResources/CommunityCollege/Materials/Structure/metallic_structures.htm

ball[c_,r_,x_]:=SquaredEuclideanDistance[c,x]≤r^2

g2=Show[With[{r=3,h=2 (Sqrt[(2/3)])},
RegionPlot3D[ball[#,1,{x,y,z}],{x,-r,r},{y,-r,r},{z,-h,h},PlotPoints->20,AspectRatio->1]&/@Join[
Append[#,0]&/@CirclePoints[Csc[Pi/3],3],
With[{top={{0,0,h},Sequence@@(Append[#,h]&/@CirclePoints[2,6])}},Join[top,{#,#2,-#3}&@@@top]]
]
],Boxed->False,Axes->False,AspectRatio->1]

Voronoi/Delauney cells

v1=Select[Tuples[{-1,0,1},3],Mod[Total[#],2]==0&]

v2=LatticeData["HexagonalClosePacking","MinimalVectors"]

Length[v2]

Table[Graphics3D[Sphere[#,.1]&/@v],{v,{v1,v2}}]

ConvexHull

ConvexHullMesh/@{v1,v2}

DelaunayMesh

DelaunayMesh/@{v1,v2}

VoronoiMesh

VoronoiMesh/@{v1,v2}

Graphics

Graphics3D[Sphere[#,Sqrt[2]/2]&/@Select[Tuples[{-1,0,1},3],Mod[Total[#],2]==0&],Boxed->False]

Graphics3D[Sphere[#,Sqrt[2]/2]&/@Select[Tuples[{-1,0,1},3],Mod[Total[#],2]==1&],Boxed->False]

Graphics3D[Sphere[#,Sqrt[2]/2]&/@Join[Permutations[{2,0,0}],-Permutations[{2,0,0}],Select[Tuples[{-1,0,1},3],Mod[Total[#],2]==0&]],Boxed->False]

Graphics3D[Sphere[#,Sqrt[2]/2]&/@Select[Tuples[Range[-2,2],3],Mod[Total[#],2]==0&],Boxed->False]

Graphics3D[Sphere[#,Sqrt[2]/2]&/@Select[Tuples[Range[-2,2],3],Mod[Total[#],2]==1&],Boxed->False]

sphere=Sphere[1,10,10];
sphere=Sphere[];
hex={
Table[TranslateShape[sphere,{2/Sqrt[3]Cos[2Pi (i+1/4)/3],2/Sqrt[3]Sin[2Pi (i+1/4)/3],h}],{i,3}],
		sphere,
Table[TranslateShape[sphere,2{Cos[2Pi i/6],Sin[2Pi i/6],0}],{i,6}],
		Table[TranslateShape[sphere,{2/Sqrt[3]Cos[2Pi (i+1/4)/3],2/Sqrt[3]Sin[2Pi (i+1/4)/3],-h}],{i,3}]
};

<<Utilities`LiveGraphics3D`

WriteLiveForm["hexcl.m",Show[Graphics3D[{hex}],Boxed->False]]

v=Flatten[{
		Table[{2/Sqrt[3]Cos[2Pi (i+1/4)/3],2/Sqrt[3]Sin[2Pi (i+1/4)/3],h},{i,3}],
		{{0,0,0}},
		Table[2{Cos[2Pi i/6],Sin[2Pi i/6],0},{i,6}],
		Table[{2/Sqrt[3]Cos[2Pi (i+1/4)/3],2/Sqrt[3]Sin[2Pi (i+1/4)/3],-h},{i,3}]},1];

WriteLiveForm["hexso.m",
	Show[Graphics3D[{circ/@{
								v[[{5,6,11,13}]],v[[{9,10,3,2}]],
				v[[{9,10,13,12}]],v[[{11,7,8,12}]],v[[{8,2,1,7}]],v[[{5,3,1,6}]]},
				tri/@{v[[{10,5,13}]],v[[{6,11,7}]],v[[{3,5,10}]],
	v[[{1,2,3}]],v[[{1,6,7}]],
					v[[{11,12,13}]],v[[{8,9,12}]],v[[{8,9,2}]]}
			}],Boxed->False]]

Show[Graphics3D[Polyhedron[RhombicDodecahedron]],Boxed->False]

Graphic

From Ed Pegg, Jr.
Jan 2019

(* something wrong here *)hcp= {{-4,-1,-1},{-1,-1,-4},{-1,-4,-1},{-3,0,3},{-3,3,0},{0,-3,3},{0,0,0},{0,3,-3},{3,-3,0},{3,0,-3},{0,3,3},{3,0,3},{3,3,0}}/3;

(*triangular orthobicupola*)
bicupv=Select[hcp,Norm[#]==(Sqrt[2])&];
bicupe=Select[Subsets[bicupv,{2}],EuclideanDistance@@#==(Sqrt[2])&];

(*trapezo-rhombic dodecahedron*)
trdv={{0,0,0},{-4,-4,2},{-4,2,-4},{0,0,6},{0,6,0},{2,-4,-4},{6,0,0},{-5,1,1},{-3,-3,-3},{-3,3,3},{1,-5,1},{1,1,-5},{3,-3,3},{3,3,-3},{3,3,3}}/6;
trde=Select[Subsets[trdv,{2}],MemberQ[{3/2,1,2}/(Sqrt[3]),EuclideanDistance@@#]&];

Graphics3D[{Opacity[.3], Sphere[#,Sqrt[2]/2]&/@Select[hcp,Norm[#]≤ Sqrt[2]&], Opacity[1], Green,Tube/@trde, Red,Tube/@bicupe}, Boxed-> False, SphericalRegion-> True, ViewAngle-> Pi/10, ImageSize-> Large]

Expansion

Trapezo-rhombic dodecahedron

Graphics3D[{Opacity[.7],PolyhedronData["SquashedDodecahedron","GraphicsComplex"]},Boxed->False,ViewPoint->{0.87, 1.96, 2.60},ViewVertical->{0.52, -0.75, 0.39},Method->{"ShrinkWrap"->True}]

Theta Series

t2[z_]:=EllipticTheta[2,0,z]
t3[z_]:=EllipticTheta[3,0,z]

Series[(t3[((8z)/3)]-t2[((8z)/3)])(t3[z]t3[3z]+t2[z]t2[3z])+(1/2)t2[((8z)/3)](t3[(z/3)]t3[z]+t2[(z/3)]t2[z]),{z,0,3}]

t2[z_]:=EllipticTheta[2,0,z^8]
t3[z_]:=EllipticTheta[3,0,z^8]

Series[(t3[((8z)/3)]-t2[((8z)/3)])(t3[z]t3[3z]+t2[z]t2[3z])+(1/2)t2[((8z)/3)](t3[(z/3)]t3[z]+t2[(z/3)]t2[z]),{z,0,10}]