2
$\begingroup$

I'm trying to construct a model of a torus with a raised graph on it, for 3D printing. I have a parametrization of a torus that I'm using to map elements in a the unit square with corners {0,0} to {1,1} to a nice torus in R^3:

paramTorus[{u_, v_}, scale_ : 1] := 
 1/(Sqrt[2] - Cos[2 Pi v])*
  scale*{ Cos[2 Pi u], Sin[2 Pi u], Sin[2 Pi v]}

I make a collection of points and lines that I want to map onto the torus: for testing purposes, we can go with

pts = Flatten[Table[{i, j}, {i, 0, 1, .4}, {j, 0, 1, .4}], 1]

and

lines = Join[
  Flatten[Table[{{i, j}, {i, j + .4}}, {i, 0, 1, .4}, {j, 0, 1, .4}], 
   1],
  Flatten[Table[{{i, j}, {i + .4, j}}, {i, 0, 1, .4}, {j, 0, 1, .4}], 
   1]]

I want to push the points and lines onto the torus, and surround the points with spheres (or balls?) and the lines with tubes, and then I want to export the collection for 3D printing.

I push the lines onto the torus by wrapping them in a function:

makeLine3[{pt1_, pt2_}, scale_ : 1] := 
 paramTorus[((1 - t) pt1 + t*pt2), scale]

Option 1: I can use parametricPlot3D to push the lines onto the torus and use PlotStyle->Tube[size] to tubify them.

pic6 = Show[{ParametricPlot3D[
    paramTorus[{u, v}, 40], {u, 0, 1}, {v, 0, 1}, Mesh -> None, 
    PlotTheme -> "ThickSurface"], 
   Graphics3D[Map[Sphere[paramTorus[#, 40], 6] &, pts]], 
   ParametricPlot3D[Map[makeLine3[#, 40] &, lines], {t, 0, 1}, 
    PlotStyle -> Tube[3], PlotRange -> All] }, Boxed -> False, 
  Axes -> None, PlotRange -> All]

This looks great on screen

picture of torus with some points and tubes on it but is slow, the spheres discretize poorly, and most frustratingly, when look at the discretized version using DiscretizeGraphics or I export using Printout3D, the torus itself does not show up, only the tubes and spheres export.

Specifically:

Printout3D[pic6, "testing.stl", RegionSize -> 40]

There is no torus here, just tubes and spheres.

Option 2: I'd rather just tubify graphics objects directly, because it's a lot faster:

makeLine2[{pt1_, pt2_}, tubeSize_ : .3] :=
 Tube[Table[paramTorus[(1 - t)*pt1 + t*pt2], {t, 0, 1, .01}], tubeSize]

When I do this, the output of Printout3D is bad (it has lots of errors on import into a slicer) and the resolution is not great. The internet suggests that there is a known problem with exporting tubes to STL directly. When I try to export using Mathematica 13, it complains enter image description here. Not sure what to do about that, either.

Discretized collection of tubes, with bad resolution

My questions:

(1) When I am using Show[stuff..] and exporting via Printout3D, why is the torus not showing up? I can either get the torus to show up, or the spheres+tubes, but I can't get torus+tubes or torus+spheres+tubes to work. Last night (before upgrading to Mathematica 13) I could get the torus+spheres to show up, but today I can't get torus+spheres to show up either.

What do I need to do to be able to export both the torus and the tubes and the spheres to .stl, ideally at a decent resolution?

(2) The spheres are discretizing as icosahedra, which looks really bad. This is frustrating. When I replace Sphere with Ball to try to get better resolution, it says that the function DiscretizeGraphics is not implemented for {my collection of balls}, depsite the fact that I can discretize an individual ball.

If folks have suggestions for how to do this better, that would be awesome. I'm using Mathematica 13.

$\endgroup$
4
  • 1
    $\begingroup$ One thing you can try to improve the resolution, so your spheres don't look like icosahedra, is to use the MaxCellMeasure option for DiscretizeGraphics. Something like MaxCellMeasure -> .01 looks decent to me. $\endgroup$
    – lericr
    Feb 12, 2022 at 0:25
  • $\begingroup$ I'm struggling with this one also, so don't have a working solution. However, I've done quite a bit of 3D Printing of things I designed with Mathematica, so maybe I'll just list some suggestions/tips, and maybe something will work in your context. $\endgroup$
    – lericr
    Feb 12, 2022 at 0:45
  • $\begingroup$ 1. Don't try to maintain perfect precision. Use machine precision or N or whatever in your paramTorus, for example. 2. If you have other tools in your design-to-print workflow, rely on them heavily. Mathematica (while it's improved in recent versions) just doesn't yet have comparable tools. So, in your case, maybe you can export the spheres, lines, and torus separately and combine them in a later step with a tool designed to handle STL. 3. Use built in functionality as much as possible. For example, you can just use a Torus, something like DiscretizeRegion[Torus[]] $\endgroup$
    – lericr
    Feb 12, 2022 at 0:50
  • $\begingroup$ Your idea of using the Torus primitive along with the tubes worked! Although wow is Mathematica 13 flaky: I keep getting the spinning wheel of death when I try to interact with the discretized object. $\endgroup$ Feb 12, 2022 at 19:00

1 Answer 1

4
$\begingroup$
  • Working around. Discretize the objects before Show.
paramTorus[{u_, v_}, scale_ : 1] := 
  1/(Sqrt[2] - Cos[2 Pi v])*
   scale*{Cos[2 Pi u], Sin[2 Pi u], Sin[2 Pi v]};
pts = Flatten[Table[{i, j}, {i, 0, 1, .4}, {j, 0, 1, .4}], 1];
lines = Join[
   Flatten[Table[{{i, j}, {i, j + .4}}, {i, 0, 1, .4}, {j, 0, 1, .4}],
     1], Flatten[
    Table[{{i, j}, {i + .4, j}}, {i, 0, 1, .4}, {j, 0, 1, .4}], 1]];
makeLine3[{pt1_, pt2_}, scale_ : 1] := 
  paramTorus[((1 - t) pt1 + t*pt2), scale];

RegionUnion[
 DiscretizeGraphics[#, MaxCellMeasure -> .01] & /@ {ParametricPlot3D[
    paramTorus[{u, v}, 40], {u, 0, 1}, {v, 0, 1}, Mesh -> None, 
    PlotTheme -> "ThickSurface", PlotPoints -> 80, MaxRecursion -> 2],
    Graphics3D[Map[Sphere[paramTorus[#, 40], 6] &, pts]], 
   ParametricPlot3D[Map[makeLine3[#, 40] &, lines], {t, 0, 1}, 
    PlotStyle -> Tube[3], PlotRange -> All, PlotPoints -> 80, 
    MaxRecursion -> 2]}, Boxed -> False, Axes -> None, 
 PlotRange -> All]
  • Simplified the code by Mesh -> {{0, .4, .8}, {0, .4, .8}} and Method -> {"BoundaryOffset" -> False}
Clear["Global`*"];
paramTorus[{u_, v_}, scale_ : 1] := 
  1/(Sqrt[2] - Cos[2 Pi v])*
   scale*{Cos[2 Pi u], Sin[2 Pi u], Sin[2 Pi v]};
pts = Flatten[Table[{i, j}, {i, 0, 1, .4}, {j, 0, 1, .4}], 1];
plot1 = ParametricPlot3D[paramTorus[{u, v}, 40], {u, 0, 1}, {v, 0, 1},
     Boxed -> False, Axes -> False, PlotPoints -> 100, 
    MaxRecursion -> 2, Mesh -> {{0, .4, .8}, {0, .4, .8}}, 
    Method -> {"BoundaryOffset" -> False}, PlotRange -> All] /. 
   Line[a_] :> Tube[a, 3];
plot2 = Graphics3D[Map[Sphere[paramTorus[#, 40], 6] &, pts]];
plot = DiscretizeGraphics[#, MaxCellMeasure -> 0.01] & /@ {plot1, 
    plot2} // RegionUnion

Export["test.stl", plot, ImageSize -> 400]
Import["test.stl"]

enter image description here

$\endgroup$
4
  • $\begingroup$ Some questions: (1) What does the RegionUnion do, after the DiscretizeGraphics? (2) In the second code, where you are doing Mesh->{...}, is that how you are getting the raised lines? They look great, but I actually want a larger collection of more complicated lines (I'm mapping a tiling from the plane), so I'm not sure I can get there via Mesh in general, unfortunately... (3) What does Method -> {"BoundaryOffset" -> False} do? $\endgroup$ Feb 13, 2022 at 2:08
  • $\begingroup$ I didn't know that I could discretize the graphics individually and combine them (I guess that's what the RegionUnion is doing). It's much faster! (Although Mathematica 13 is being wretchedly slow.) $\endgroup$ Feb 13, 2022 at 2:25
  • $\begingroup$ @LeahWrennBerman (3) Method -> {"BoundaryOffset" -> False} can attain the boundary line. Compare with Method -> {"BoundaryOffset" -> True} . (2) We can draw another lines by Mesh if the lines is describe by a implicit equation. $\endgroup$
    – cvgmt
    Feb 13, 2022 at 2:30
  • $\begingroup$ All these suggestions are great, and combining them I can get a discretized region that looks perfect. Interestingly, if I Export to STL I can get all the decorations correctly (although I still get errors when I import to my slicing program), but if I use Printout3D most of the tubes and spheres don't show up after export. It's so weird (and frustrating)! $\endgroup$ Feb 13, 2022 at 21:23

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.