# Create a torus with a hexagonal mesh for 3D-printing

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


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

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


-

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:

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. I leave that for other interested parties to investigate. Here is a picture for $r = 1.1$, $m = 30$, $n = 20$:

-
This looketh great! :D –  Yves Klett Jan 7 at 12:19

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


% /. Polygon -> Tube


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


-