Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I am new to Mathematica, and I'm looking for a way to create patterns on the surface of 3D objects. One thing I have not been able to do is create a hexagonal mesh on a torus. What I would like to have is a hexagonal mesh that has a certain thickness (so it would be 3D printable). So far, I have been able to create the torus itself. I am not sure of how to create the hexagonal pattern on the surface and the process of mapping it onto the torus.

ParametricPlot3D[{Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]},
  {t, 0, 2 Pi}, {u, 0, 2 Pi}]

Mathematica graphics

share|improve this question
    
I have this so far... I haven't figured out yet how to make the outer hexagons the same size as the inner ones. –  The Toad Jan 6 '14 at 4:45
    
@rm-rf I don't think you can have all the hexagons equally sized. –  belisarius Jan 6 '14 at 5:15
    
Can you use the meshing capability of the IMTEK Mathematica Package simulation.uni-freiburg.de/downloads/ims –  s0rce Jan 6 '14 at 6:05

3 Answers 3

We can do this by building a regular hexagon tile and wrapping it onto a torus:

hexTile[n_, m_] := 
    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, n}, {j, m}] /. 
            {x_?NumericQ, y_?NumericQ} :> 2 π {x/(3 m), 2 y/(n Sqrt[3])}
    ]

ht = With[{torus = {Cos[#] (3 + Cos[#2]), Sin[#] (3 + Cos[#2]), Sin[#2]} &},
    Graphics3D[hexTile[20, 20] /. Polygon[l_List] :> Polygon[torus @@@ l], Boxed -> False]
]

You can now convert this to a wire frame by changing the polygons to lines or tubes, whichever is convenient for you:

ht /. Polygon[x__] :> {Thick, Line@x}

ht /. Polygon -> Tube

share|improve this answer

I propose a small modification to the parametrization for the torus that addresses issues with conformality. Try

F[t_, u_, r_] := {Cos[t] (r + Cos[u + Sin[u]/r]),
                  Sin[t] (r + Cos[u + Sin[u]/r]),
                  Sin[u + Sin[u]/r]}

instead. Next, we wish to choose suitable values for $m, n$ for a given $r$ such that the mapping of the regular hexagonal tiling preserves angles as much as possible. We see that this requires us to choose $m, n$ such that $$\frac{\sqrt{3}}{2} \frac{n}{m} = r.$$ As we also require $n$ to be even (or else the tiling does not fit properly on the torus), we can let $n = 2k$ and this gives us $k \sqrt{3} = rm$; thus for a given $r$ we should try to choose $k, m$ as the nearest integers satisfying this equation. This gives us a very nearly angle-preserving tiling. For example, with $r = 2 \sqrt{3}$, we can choose $m = 11$, $n = 44$ to get something that looks like this: enter image description here

Notice how much more regular the hexagons are throughout the torus--the "inner" ones are not squashed, and the outer ones are not stretched.


Addendum. So, the above seems to work reasonably well for large $r$, but when $r = 1 + \epsilon$ for small $\epsilon$, it doesn't work because the mapping I chose is not truly conformal. I found the relevant information here: http://math.stackexchange.com/questions/152156/conformal-mappings-between-the-flat-torus-and-the-embedded-torus

This suggests the correct form of $f$ should be

F[t_, u_, r_] := {Cos[t], Sin[t], Sin[# u]/#} #^2/(r - Cos[# u]) &[Sqrt[r^2 - 1]]

And whereas $t$ is still plotted on the same interval, we need to plot $u$ on $\left(-\frac{\pi}{\sqrt{r^2-1}}, \frac{\pi}{\sqrt{r^2-1}}\right)$. So we modify the plotting command as well:

P[r_, m_, n_] := Graphics3D[Polygon /@ 
     Table[F[4 Pi/(3 n) (Cos[Pi k/3] + i 3/2),
           2 Pi/(Sqrt[3 (r^2 - 1)] m) (Sin[Pi k/3] + (j + i/2) Sqrt[3]), 
           r], {i, n}, {j, m}, {k, 6}], Boxed -> False]

And now the selection of $m, n$ based on $r$ is also more complicated. $n = 2m \sqrt{\frac{r^2 - 1}{3}}$ seems to give good results. Here is a picture for $r = 1.1$, $m = 30$, $n = 20$: enter image description here


This solution calculates exact coordinates. However, for 3d-printing machine precision is usually enough, and affords a significant speedup. We can force machine arithmetic by adding dots after some of the constants (e.g. 2 Pi to 2. Pi). We can also achieve a 3x speed up by only calculating the location of each vertex once, and using GraphicsComplex to share the locations with each hex. (This is how 3d formats like .stl work internally. If you need regular polygon objects to process further, just use Normal to eliminate GraphicsComplex.)

Pfast[r_, m_, n_] := 
 Graphics3D[
  GraphicsComplex[
   Flatten[Table[
     F[2. Pi (i + k/3.)/n, Pi (1. + i + 2 j)/m/Sqrt[r^2 - 1.], 
      r // N], {j, m}, {i, n}, {k, {-1, +1}}], 2], 
   Polygon[Join @@ 
     Table[Mod[(j - 1) (2 n) + {1, 2, 3 + If[i == n, n (n - 2), 0]}~
         Join~({2, 1, If[i == 1, n (2 - n), 0]} + 2 n) + 2 (i - 1), 
       2 n m, 1], {i, n}, {j, m}]]], Boxed -> False]

The code is almost the same as before, except that we now only need to generate two new coordinates for each cell, so Cos[Pi k/3] only takes on two values and Sin[Pi k/3] only takes on one value, allowing the arithmetic to be simplified considerably. We don't need to change F; it's already extremely fast due to the two-stage calculation it does to avoid recomputing the expensive square root multiple times.

We can do a timing and memory usage comparison of the two versions:

ByteCount[P2[2, 50, 100]] // Timing
(* {0.343750, 1440448} *)
ByteCount[P[2, 50, 100]] // Timing
(* {5.921875, 60849648} *)

The numerical version is around 20 times faster and gives a result 40 times smaller. It's actually now fast enough to quickly make a nice table of tori with different parameters:

GraphicsGrid[
 ParallelTable[
  With[{n = 2 Round[m Sqrt[(r^2 - 1)/3]]}, 
   Show[P2[r, m, n], PlotLabel -> {r, m, n}]], {r, {1.1, 1.5, 2, 3, 
    5}}, {m, {6, 10, 15, 20, 30, 50}}], ImageSize -> Full]

enter image description here

share|improve this answer
1  
This looketh great! :D –  Yves Klett Jan 7 '14 at 12:19
    
I found that n = 2 Round[m Sqrt[(r^2 - 1)/3]] gives close to ideal shapes. (found by optimizing one of the angles of the innermost ring of hexes) Something like GraphicsGrid[ParallelTable[With[{n = 2 Round[m Sqrt[(r^2 - 1)/3]]}, Show[P[r // N, m, n], PlotLabel -> {r, m, n}]], {r, {1.1, 1.5, 2, 3, 5}}, {m, {6, 10, 15, 20, 30, 50}}], ImageSize -> Full] gives you an idea of how good your solution is to handling all types of geometries. –  2012rcampion Apr 10 at 20:16
    
I was playing around with your code, and I've made a much faster/smaller version. Mind if I append it to your answer? –  2012rcampion Apr 10 at 21:51

There is an explicit formula

n = 30;
m = 10;

f[t_, u_] := {Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]};

Graphics3D[Polygon /@ Table[
  f[(4 π)/(3 n) (Cos[π k/3] + i 3/2), (2 π)/(Sqrt[3] m) (Sin[π k/3] + (j + i/2) Sqrt[3])], 
    {i, n}, {j, m}, {k, 6}]]

enter image description here

% /. Polygon -> Tube

enter image description here

I find it a bit simpler than rm -rf's solution.

Here f transforms from toroidal coordinates to Cartesian coordinates. Without f it is a plain hexagonal tiling

Graphics[{White, EdgeForm[Black], 
  Polygon /@ Table[{Cos[π k/3] + i 3/2, Sin[π k/3] + (j + i/2) Sqrt[3]}, 
   {i, n}, {j, m}, {k, 6}]}]

enter image description here

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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