Message Boards Message Boards

0
|
1355 Views
|
2 Replies
|
0 Total Likes
View groups...
Share
Share this post:

Rhombus pattern on Torus and STEP-Export for e.g. Solidworks

Nils H.
Posted 1 year ago

Hello,

I would like to create a torus (Øi=30, Øa=34) with 24 rhombi on every row (4 rows per quarter). Then it shall be exported as step for further useage in Solidworks. I found an example but am not able to modify it for my needs. It comes with hexagonal pattern on 3 rows per quarter.

https://mathematica.stackexchange.com/questions/39879/create-a-torus-with-a-hexagonal-mesh-for-3d-printing

Only managed to get 24 hexagonals on every row. Also I managed to get a solely torus with desired measures. But thats it :/

With 24 hexagonal tiles a row:

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[24, 24] /. Polygon[l_List] :> Polygon[torus @@@ l], Boxed -> False]
]

And Torus with desired dimensions:

Graphics3D[Torus[{0, 0, 0}, {30, 34}]]

Any idea?
POSTED BY: Nils H.
2 Replies
Sort By:
Nils H.
Nils H.
Posted 1 year ago

Thank you very much. Looks pretty good so far. But how can I modify number of rhombs (24 equatorial and 16 around section diameter) and diameters of torus? Is there a chance to get flat rhombs? On your second code rhombs are bend in middle.
POSTED BY: Nils H.

Here are rhombs drawn on a plane and on a parametric torus using Mesh:

Clear[x, y, i, j, i0, j0]
myTorus[x_, y_] = {Cos[x] (16 + Cos[y]), Sin[x] (16 + Cos[y]), Sin[y]};
ParametricPlot3D[{x, y, 0}, {x, 0, 2 Pi}, {y, 0, 2 Pi}, 
 MeshFunctions -> {2 #4 + #5 &, 2 #4 - #5 &}, 
 Mesh -> {Range[0, 6 Pi, Pi/4], Range[-2 Pi, 5 Pi, Pi/4]}]
ParametricPlot3D[myTorus[x, y], {x, 0, 2 Pi}, {y, 0, 2 Pi}, 
 MeshFunctions -> {2 #4 + #5 &, 2 #4 - #5 &}, 
 Mesh -> {Range[0, 5 Pi, Pi/4], Range[-2 Pi, 5 Pi, Pi/4]}, 
 PlotPoints -> 100]

and next as a collection of 3D polygons having vertices in the mesh intersections:

vert[i0_, j0_] = 
  First@SolveValues[{2 x + y == Pi/4 i0, 
      2 x - y == -2 Pi + Pi/4 j0}, {x, y}] // Simplify;
rhombTile[i_, j_] = 
  Line[{vert[i, j], vert[i + 1, j], vert[i + 1, j + 1], 
    vert[i, j + 1]}];
Graphics3D[
 Union[Flatten@Table[rhombTile[i, j], {i, 0, 40}, {j, 0, 8}] /. 
    Line[pts_] :> Polygon[MapApply[myTorus, pts]]] /. 
  plg_Polygon :> {RandomColor[], plg}]
POSTED BY: Gianluca Gorni
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract