10
$\begingroup$

So I tried this code for 2D, but I would like to have say a slab with a defined thickness

The code for 2D is

h[x_, y_] := Polygon[Table[{Cos[2 Pi k/6] + x, Sin[2 Pi k/6] + y}, {k, 6}]]
Graphics[
  {EdgeForm[Opacity[.7]], LightBlue, 
   Table[h[3 i + 3 ((-1)^j + 1)/4, Sqrt[3]/2 j], {i, 11}, {j, 12}]}]

enter image description here

But how do I to convert it to 3D?

I also found and modified this code:

Graphics3D[
  With[{hex = Polygon[Table[{Cos[2 Pi k/6] + #, Sin[2 Pi k/6] + #2},{k,6}]]&},
    Table[hex[3 i +3 ((-1)^j + 1)/4, Sqrt[3]/2 j], {i,10},{j,15}]] /. 
      Polygon[l_List] :> Polygon[top @@@ 1], 
  Boxed -> False, Axes -> False, PlotRange -> All, Lighting -> "Neutral"]

enter image description here

But I can't specify the thickness.

$\endgroup$
1
  • 1
    $\begingroup$ What do you mean by thickness? Would you like to have hexagonal prims instead of flat hexagons? $\endgroup$ Commented Feb 24, 2018 at 8:29

2 Answers 2

16
$\begingroup$

Does this do what you are looking for?

The following function takes a parameterization surface and a region region and tries to mesh it with hexagons of radius meshsize. Afterwards, it maps surface over it and creates a mesh of extruded hexagons of thickness thickness

ClearAll[hexhex]
hexhex[surface_, thickness_, meshsize_, region_] := 
 Module[{hex0, centers0, centers, m, n, shifts, planehex, 
   surfacenormal, normals, midlayer, toplayer, bottomlayer, topidx, 
   bottomidx, mantles, B, p0, regmemb},
  B = BoundingRegion[DiscretizeRegion[region]];
  p0 = RegionCentroid[B];
  regmemb = RegionMember[region];

  hex0 = Table[meshsize {Cos[Pi k/3.], Sin[Pi k/3.]}, {k, 0, 5}];
  shifts = MovingAverage[(2. meshsize) Table[ {Cos[Pi k/3.], Sin[Pi k/3.]}, {k, -1, 1}], 2];
  {m, n} = Max /@ Transpose[{
      Ceiling[Abs[LinearSolve[shifts\[Transpose], B[[2]] - p0]]],
      Ceiling[ Abs[LinearSolve[ shifts\[Transpose], {B[[1, 2]], B[[2, 1]]} - p0]]]
      }];
  centers0 = Plus[
    Flatten[Outer[List, Range[-m, m], Range[-n, n]], 1].shifts,
    ConstantArray[p0, (2 m + 1) (2 n + 1)]
    ];
  centers = Pick[centers0, regmemb /@ centers0];
  planehex = Outer[Plus, centers, hex0, 1];

  Quiet[Block[{X},
    surfacenormal = X \[Function] Evaluate[
       Normalize[
        Cross @@Transpose[D[surface[{X[[1]], X[[2]]}], {{X[[1]], X[[2]]}, 1}]]]
       ]]];

  midlayer = Map[surface, planehex, {2}];
  normals = Map[surfacenormal, planehex, {2}];
  toplayer = midlayer + 0.5 thickness normals;
  bottomlayer = midlayer - 0.5 thickness normals;

  topidx = Partition[Append[Range[6], 1], 2, 1];
  bottomidx = Reverse /@ topidx;
  mantles = Join[
    ArrayReshape[
     toplayer[[All, Flatten[topidx]]], {Length[toplayer], 6, 2, 3}],
    ArrayReshape[
     bottomlayer[[All, Flatten[bottomidx]]], {Length[bottomlayer], 6, 
      2, 3}],
    3
    ];
  {toplayer, Flatten[mantles, 1], bottomlayer}
  ]

Usage example:

surface = Quiet[Block[{X, z, f, g},
    f = z \[Function] 1;
    g = z \[Function] z;
    X \[Function] Evaluate[
      N@ComplexExpand[{
          Re[Integrate[f[z] (1 - g[z]^2)/2, z]],
          Re[Integrate[I f[z] (1 + g[z]^2)/2, z]],
          Re[Integrate[f[z] g[z], z]]
          } /. {z -> (X[[1]] + I X[[2]])}]
      ]
    ]];
meshsize = 0.025;
thickness = 0.1;
region = Disk[{0., 0.}, 1.6];
data = hexhex[surface, thickness, meshsize, region];
Graphics3D[{Specularity[White, 30], EdgeForm[{Thin, Black}],
  Darker@Darker@Red, Polygon[data[[1]]],
  Darker@Darker@Blue, Polygon[data[[2]]],
  Darker@Darker@Green, Polygon[data[[3]]]
  },
 Lighting -> "Neutral"
 ]

enter image description here

The planar region may be rather arbitrary, for example, we can use this sea star:

c = t \[Function] (2 + Cos[5 t])/3 {Cos[t], Sin[t]};
region = Module[{pts, edges, B},
   pts = Most@Table[c[t], {t, 0., 2. Pi, 2. Pi/2000}];
   edges = Append[Transpose[{Range[1, Length[pts] - 1], Range[2, Length[pts]]}], {Length[pts], 1}];
   BoundaryMeshRegion[pts, Line[edges]]
   ];
data = hexhex[surface, thickness, 0.5 meshsize, region];
Graphics3D[{Specularity[White, 30], EdgeForm[{Thin, Black}],
  Darker@Darker@Red, Polygon[data[[1]]],
  Darker@Darker@Blue, Polygon[data[[2]]],
  Darker@Darker@Green, Polygon[data[[3]]]
  },
 Lighting -> "Neutral"
 ]

enter image description here

Edit

Because DiscretizeRegion and RegionMember were introduced with version 10, I also provide the following function that takes a list of 6-tuples of points in the plane that represents the hexagon, maps them by the parameterization surface to $\mathbb{R}^3$, and extrudes them.

ClearAll[hexhex2]
hexhex2[surface_, thickness_, planehex_] := Module[{surfacenormal, normals, midlayer, toplayer, bottomlayer, topidx, bottomidx, mantles, B, p0, regmemb},
  Quiet[Block[{X}, 
    surfacenormal = X \[Function] Evaluate[ Normalize[ Cross @@ Transpose[D[surface[{X[[1]], X[[2]]}], {{X[[1]], X[[2]]}, 1}]]]]]];
  midlayer = Map[surface, planehex, {2}];
  normals = Map[surfacenormal, planehex, {2}];
  toplayer = midlayer + 0.5 thickness normals;
  bottomlayer = midlayer - 0.5 thickness normals;
  topidx = Partition[Append[Range[6], 1], 2, 1];
  bottomidx = Reverse /@ topidx;
  mantles = 
   Join[ArrayReshape[
     toplayer[[All, Flatten[topidx]]], {Length[toplayer], 6, 2, 3}], 
    ArrayReshape[
     bottomlayer[[All, Flatten[bottomidx]]], {Length[bottomlayer], 6, 
      2, 3}], 3];
  {toplayer, Flatten[mantles, 1], bottomlayer}];

Use it like this:

h2[x_, y_] := Table[N@{Cos[2 Pi k/6] + x, Sin[2 Pi k/6] + y}, {k, 6}]
planehex = Flatten[Table[h2[3 i + 3 ((-1)^j + 1)/4, Sqrt[3]/2 j], {i, 11}, {j, 12}], 1]; 
surface = X \[Function] {X[[1]], X[[2]], 0.};
thickness = 1;
data = hexhex2[surface, thickness, planehex];
Graphics3D[{Specularity[White, 30], EdgeForm[{Thin, Black}], 
  Darker@Darker@Red, Polygon[data[[1]]], Darker@Darker@Blue, 
  Polygon[data[[2]]], Darker@Darker@Green, Polygon[data[[3]]]}, 
 Lighting -> "Neutral"]
$\endgroup$
3
  • $\begingroup$ Wow this looks nice but i get error when I am compiling it. 'Part::partw: "Part 2 of BoundingRegion[DiscretizeRegion[Disk[{0.,0.},1.6]]] does not exist." Part::partw: "Part 2 of DiscretizeRegion[Disk[{0.,0.},1.6]] does not exist." Part::partw: "Part 2 of BoundingRegion[DiscretizeRegion[Disk[{0.,0.},1.6]]] does not exist." General::stop: "Further output of \!(* StyleBox[ RowBox[{\"Part\", \"::\", \"partw\"}], \"MessageName\"]) will be suppressed during this calculation. " ' And a long line of other errors,,,,, $\endgroup$ Commented Feb 24, 2018 at 23:22
  • $\begingroup$ Which Mathematica version do you use? $\endgroup$ Commented Feb 24, 2018 at 23:25
  • $\begingroup$ its version 9,, $\endgroup$ Commented Feb 24, 2018 at 23:39
6
$\begingroup$

If you want a planar hexagon mesh, then this will do it:

face[{pt1_, pt2_}, h_: 1] := Polygon[{
   Append[pt1, 0],
   Append[pt2, 0],
   Append[pt2, h],
   Append[pt1, h]
   }]
top[pts_, h_: 1] := Polygon[Append[h] /@ pts]
bottom[pts_] := Polygon[Append[0] /@ pts]
hexagon[c_, h_: 1] := Module[{pts, hex},
  pts = Map[c + # &, CirclePoints[6]];
  hex = Prepend[#, Last[#]] &@pts;
  {top[hex, h], bottom[hex], face[#, h] & /@ Partition[hex, 2, 1]}
  ]

hexGrid3D[nx_, ny_, h_: 1] := Table[
   hexagon[{3 i + 3 ((-1)^j + 1)/4, Sqrt[3]/2 j}, 5],
   {i, nx}, {j, ny}
   ];

Graphics3D[
 hexGrid3D[10, 10, 3]
 ]

Mathematica graphics

The argument h in hexGrid3D[nx, ny, h] is the height of the hexagons. nx and ny controls the number of elements in the x and y directions.

$\endgroup$
4
  • $\begingroup$ Yes this is good but unfortunately i get following error: Append::argr: Append called with 1 argument; 2 arguments are expected. And it doesn't look like mathematica recognized 'CirclePoints[6]]' and arguments for append are missing,,,, can you check it ? $\endgroup$ Commented Feb 24, 2018 at 23:26
  • $\begingroup$ @RacaioCmoto It only works with a Mathematica version >= 10.1. I'm guessing you are using Mathematica 9? You can make it compatible with 9 by replacing e.g. Append[h] with Append[#, h] & and CirclePoints by Table[{Sin[x], Cos[x]}, {x, 0, 2 Pi, 2 Pi/6}]. $\endgroup$
    – C. E.
    Commented Feb 25, 2018 at 7:56
  • $\begingroup$ Yeah , I think something else is missing too,, Coordinate Slot[1, 0][{31.5, 9.660254037844386}] should be a triple of numbers, or a Scaled form $\endgroup$ Commented Mar 1, 2018 at 20:25
  • $\begingroup$ @RacaioCmoto I'm pretty sure nothing else needs to be replaced. I can't say what goes wrong from that error message, you'll have to pick apart the function to see where it is coming from. $\endgroup$
    – C. E.
    Commented Mar 1, 2018 at 21:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.