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. –  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

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

share|improve this answer
1  
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}]]

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.