Preparing surfaces for 3D printing in Mathematica

S. Gilles

2019-01-30

Recently I wanted a physical model of a certain Seifert surface
that I'd seen with SeifertView [0]. There are quite a few Seifert
surfaces on model archives such as Thingiverse, but the one I wanted
wasn't quite there. I managed to get a usable model out of Mathematica;
these notes are for when I need to do it again.

I wanted a Seifert surface of the link composed of six consecutive
half-twists. The specific view I wanted looks like two discs parallel
to the xy-plane, lying at z = -1 and 1. There are six strips which
connect the two discs, each leaving the top disc at some kπ/3,
curving down to become vertical, performing a half twist, flattening
out, and reconnecting to the bottom disc at the same kπ/3.

Plotting this in Mathematica took some time and a few usual tricks,
and is relatively uninteresting:

    spine[theta_,t_]:={
        Sin[t*Pi/2]*Cos[theta],
        Sin[t*Pi/2]*Sin[theta],
        Cos[t*Pi/2]
    }
    d=0.25
    maxt[s_]:=(7*Pi*(d-0.2)^2)/(12*(-0.2-s))+2*d-(7*Pi*(d-0.2))/12
    bump1[t_]:=If[t<0,0,If[t<Pi/2,1-Cos[t]],t+1-Pi/2]
    bump2[t_]:=bump1[t - 0.4]*(Pi/2)/bump1[1-0.4]
    slapz[z_]:=If[Abs[z]<0.7,z,Sign[z]*(
            If[Abs[z]>0.9,0.8,Sin[(Abs[z]-0.7)/(0.9-0.7)*Pi/2]*(0.8-0.7)+0.7]
        )]
    clampz[{x_,y_,z_}]:={x,y,slapz[z]}
    wing[u_,t_,s_]:=(
            spine[u,t]+
            s*Cos[bump2[t]]*{Sin[u],-Cos[u],0} +
            s*Sin[bump2[t]]*{Sin[t*Pi/2]*Cos[u],Sin[t*Pi/2]*Sin[u],Cos[t*Pi/2]}
        ) // clampz
    swidth[t_]:=0.16+0.15/(1+Exp[-70*(0.23-t)])
    thing=ParametricPlot3D[
            {
                wing[0*Pi/3,t,s],wing[0*Pi/3,t,s]*{1,-1,-1},
                wing[1*Pi/3,t,s],wing[1*Pi/3,t,s]*{1,-1,-1},
                wing[2*Pi/3,t,s],wing[2*Pi/3,t,s]*{1,-1,-1},
                wing[3*Pi/3,t,s],wing[3*Pi/3,t,s]*{1,-1,-1},
                wing[4*Pi/3,t,s],wing[4*Pi/3,t,s]*{1,-1,-1},
                wing[5*Pi/3,t,s],wing[5*Pi/3,t,s]*{1,-1,-1},
            },
            {t,0,1}, {s,-swidth[t],swidth[t]},PlotRange->All
        ]

In order to 3D print this, I needed to

 - make it a solid, 3-dimensional figure, not just an embedded
   surface
 - remove the odd cracks that appeared in Mathematica's rendering
   for some reason
 - turn it into an stl file

The important solutions are

 - PlotStyle->Thickness[0.05]
 - Exclusions->None
 - Export["/path/to/some/file.stl", $result_of_ParametricPlot3D]

So my result looks like

    ...
    thing=ParametricPlot3D[
            {
                wing[0*Pi/3,t,s],wing[0*Pi/3,t,s]*{1,-1,-1},
                ...
                wing[5*Pi/3,t,s],wing[5*Pi/3,t,s]*{1,-1,-1},
            },
            {t,0,1},{s,-swidth[t],swidth[t]},PlotRange->All,
            PlotStyle->Thickness[0.05],
            Exclusions->None
        ]
    Export["/tmp/a6.stl", thing]

The resulting file prints just fine.

[0] http://www.win.tue.nl/~vanwijk/seifertview/