Parametric Plotting of Surfaces

COA Code

c=WeierstrassInvariants[{0.5,0.5I}][[1]];
e=WeierstrassP[0.5,{c,0}];
Z[z_]=WeierstrassZeta[z,{c,0}];

Costa[z_] := With[{a= z+(( Z[z-(1/2)]-Z[z-(I/2)])/(2 e)),b=((Z[z])/π)-((π(1-I))/(4e)),d=WeierstrassP[z,{c,0}]},
		(π/2){Re[a-b],Im[a+b],(1/(Sqrt[2π]))Log[Abs[((d-e)/(d+e))]]}];

plot2=ParametricPlot3D[Costa[u+I v],{u,0,1},{v,0,1},PlotRange->All,RegionFunction->(Norm[{#1,#2,#3}]<5&),Mesh->None,MaxRecursion->2];
polygons2=Cases[Normal[Graphics3D[Cases[Normal[plot2],_Polygon,∞],RegionFunction->(Norm[{#1,#2,#3}]≤2.7&)]],_Polygon,∞];

Graphics3D[{EdgeForm[],FaceForm[{Orange,Specularity[White,20]},{Blue,Specularity[White,20]}],polygons2},Boxed->False, ViewAngle->0.34]

tor[u_,v_]:={Sin[2 π (u+0.5)] (2+Cos[v 2 π]),Sin[-2 π v],-Cos[2 π (u+0.5)] (2+Cos[2 π v])};

radius[_]=2.7;
radius[0.|0] = 3.02;
radius[0.1]=2.93;
radius[0.2]=2.76;
radius[0.3]=2.68;

Morph[t_] := ParametricPlot3D[
 (1-t) tor[u,v]+t Costa[u+I v],{u,0,1},{v,0,1},PlotRange->All,RegionFunction->(Norm[{#1,#2,#3}]<5&),Mesh->None,MaxRecursion->2];

polygons[t_]:=Cases[Normal[Graphics`Mesh`GeometryPlot3D[Cases[Normal[Morph[t]],_Polygon,∞],RegionFunction->(Norm[{#1,#2,#3}]≤radius[t]&)]],_Polygon,∞];

finalMorph[t_, opts___]:=finalMorph[t, opts]=
Graphics3D[{EdgeForm[],FaceForm[{Orange,Specularity[White,20]},{Blue,Specularity[White,20]}],polygons[t]},opts,ImageSize->200,Boxed->False];

Monitor[Do[finalMorph[t],{t,0,1,0.1}],t]

GraphicsGrid[{{finalMorph[0.],finalMorph[0.2]},{finalMorph[0.4],finalMorph[0.6]},{finalMorph[0.8],finalMorph[1.]}},Spacings->-70,ImageSize->420]

.  Introduction to ParametricPlot3D

ParametricPlot3D[{Cos[θ],Sin[θ],θ},{θ,0,10 π},BoxRatios->{1,1,0.4},
	AxesLabel->{"x","y","z"},Boxed->False]

ParametricPlot3D[{Cos[θ],Sin[θ],θ},{θ,0,10π},BoxRatios->{1,1,0.6},Boxed->False,PlotStyle->Thick,Ticks->False,Axes->False,ColorFunction->(Hue[#4]&), Background->Gray]

ParametricPlot3D[{Cos[θ],Sin[θ],z},{θ,0,2 π},{z,0,1},BoxRatios->{1,1,0.8},PlotPoints->{40,2},AxesLabel->{"x","y",None},Boxed->False]

ParametricPlot3D[{z Cos[θ],z Sin[θ],z},{θ,0,2 π},{z,0,1},BoxRatios->{1,1,0.8},PlotPoints->{40,2},Axes->None,Boxed->False]

ParametricPlot3D[{Cos[ϕ] Cos[θ],Cos[ϕ] Sin[θ],Sin[ϕ]},{θ,0,2 π},{ϕ,-(π/2),(π/2)},PlotPoints->20,Axes->None,Boxed->False,BoxRatios->{1,1,1},ViewPoint->{1.3,-2.4,1}]

f[x_,y_]:=x y/((x^2)+(y^2));

Plot3D[f[x,y],{x,-2,2},{y,-2,2},Boxed->False]

f[r Cos[θ],r Sin[θ]] //Simplify

ParametricPlot3D[{r Cos[θ],r Sin[θ],Cos[θ] Sin[θ]},{θ,0,2 π},{r,0.1,1},ViewPoint->{-1.5,-2.8,2.8},BoxRatios->{1.5,1,1.5},PlotPoints->{50,10},Boxed->False,Axes->None,Mesh->{Range[0,2 π-((2 π)/40),((2 π)/40)],2},BoundaryStyle->Black]

circle[θ_]:= {4+Cos[θ], 0, Sin[θ]};
torus=RotationTransform[ϕ,{0,0,1}][circle[θ]]

ParametricPlot3D[torus,{ϕ,0,2 π},{θ,0,2 π},Boxed->False]

circle[θ_,s_]:={4,0,0}+s {Cos[θ],0,Sin[θ]};
moebius[τ_:1/2]:=RotationTransform[ϕ,{0,0,1}][circle[τ ϕ,s]];
ParametricPlot3D[Evaluate[moebius[1/2]],{ϕ,0,2 π},{s,-1,1},Boxed->False, Mesh->{60,2}, BoundaryStyle->Black]

ParametricPlot3D[Evaluate[moebius[1.5]],{ϕ,0,2 π},{s,-1,1},Boxed->False,Axes->False, Mesh->{60,2}, BoundaryStyle->Black]

ParametricPlot3D[Evaluate[moebius[]],{ϕ,0,2 π},{s,-1,1},Mesh->{30,3},Boxed->False,Axes->None,BoundaryStyle->Black, PlotStyle->FaceForm[Orange,Blue]]

ParametricPlot3D[Evaluate[moebius[]],{ϕ,0,2 π},{s,-1,1},Mesh->{30,2},Boxed->False,Axes->False,MeshStyle->{Black,{White, Thick}},ColorFunctionScaling->False, BoundaryStyle->Black, PlotStyle->FaceForm[Red, Green],
ColorFunction->(If[-(1/3)<#5<(1/3),Blue,FaceForm[Red,Green]]&)]

Show[ParametricPlot3D[Evaluate[moebius[]],{ϕ,0,2 π},{s,-1,-(1/3)},Mesh->None,PlotStyle->FaceForm[Red,Green],BoundaryStyle->Black],ParametricPlot3D[Evaluate[moebius[]],{ϕ,0,2 π},{s,1/3,1}, Mesh->None,PlotStyle->FaceForm[Green,Red], BoundaryStyle->Black],
ParametricPlot3D[Evaluate[moebius[]],{ϕ,0,2 π},{s,-1/3,1/3}, Mesh->None, PlotStyle->FaceForm[Blue,Cyan],BoundaryStyle->Black], PlotRange->All, Lighting->"Neutral", Axes->False, Boxed->False]

circle[θ_]:={4+Cos[θ],0,Sin[θ]};
torus=RotationTransform[ϕ,{0,0,1}][{4+Cos[θ],0,Sin[θ]}];
plane={0,ϕ,θ};cylinder={Cos[θ],ϕ,Sin[θ]};

Manipulate[If[t<1,
ParametricPlot3D[(1-t)plane+t cylinder, {θ,-π,π}, {ϕ,-π,π},Mesh->10, PlotRange->5, Boxed->False, BoundaryStyle->Black],
ParametricPlot3D[(1-(t-1))cylinder+(t-1)torus, {θ,-π,π}, {ϕ,-π,π},Mesh->10, PlotRange->5, Boxed->False,BoundaryStyle->Black]], {t,0,2}]

.  A Classic Torus Dissection

{r,R}={3,5};
torus=ParametricPlot3D[{(R+r Cos[ϕ]) Cos[θ],(R+r Cos[ϕ]) Sin[θ],r Sin[ϕ]},
{θ,0,2 π},{ϕ,0,2 π}, Mesh->None];
cut[1]=Plot3D[0.8 x,{x,-5,5},{y,-9,9}, PlotStyle->{Gray,Opacity[0.2]}, Mesh->15];cut[2]=Plot3D[-0.8 x,{x,-5,5},{y,-9,9},PlotStyle->{Gray,Opacity[0.2]},Mesh->15];cut[3]=ParametricPlot3D[{-(1/3) (y+5),y,z},{y,-9,9},{z,-4,4},PlotStyle->{Gray,Opacity[0.2]},Mesh->15];
cuts = Map[cut, {1,2,3}];

Show[torus,cuts,BoxRatios->Automatic,Boxed->False,Axes->False]

colors={Red, Gray,Green, Cyan, Magenta, Yellow, Orange, Blue};

colorTensor=Partition[Partition[colors,2],2]

ArrayDepth[colorTensor]

torus=ParametricPlot3D[{(R+r Cos[ϕ]) Cos[θ],(R+r Cos[ϕ]) Sin[θ],r Sin[ϕ]},{θ,0,2 π},{ϕ,0,2 π},MeshFunctions->{#3-0.8 #1&,#3+#1 0.8&,3 #1+(#2+5)&},Mesh->{{0},{0},{0}},MeshShading->colorTensor,Boxed->False,Axes->False,Lighting->"Neutral"];

Show[torus,cuts,PlotRange->{{-9,9},{-9,9},{-3,3}},ViewPoint->{0.8,2,2},Boxed->False,Axes->False]

insideTorusQ[{x_,y_,z_}]:=(((R-(Sqrt[(x^2)+(y^2)])))^2)+(z^2)≤(r^2);

regionFcnsQ[choice_][x_,y_,z_]:=And@@{-z<-(-0.8 x),-z<-0.8 x,-3 x<-(-(y+5)),insideTorusQ[{x,y,z}]}[[choice]];

pp=ParametricPlot3D[{(R+r Cos[ϕ]) Cos[θ],(R+r Cos[ϕ]) Sin[θ],r Sin[ϕ]},{θ,0,2 π},{ϕ,0,2 π}, Boxed->False, Axes->False, Lighting->"Neutral", PlotStyle->Red,RegionFunction->Evaluate[regionFcnsQ[{1,2,3,4}][#1, #2, #3]&],PlotPoints->50,MaxRecursion->4, Mesh->False, BoundaryStyle->{Thickness[0.005], Black}]

cuts={
ParametricPlot3D[{x,y,-0.8 x},{x,-8.1,8.1},{y,-8,8},RegionFunction->Evaluate[regionFcnsQ[{2,3,4}][#1, #2, #3]&],PlotPoints->30,MaxRecursion->4,PlotStyle->Green,Mesh->False,BoundaryStyle->{Thickness[0.005],Black}],
ParametricPlot3D[{x,y,0.8 x},{x,-8,8},{y,-8,8},RegionFunction->Evaluate[regionFcnsQ[{1,3,4}][#1, #2, #3]&],PlotPoints->30,MaxRecursion->4,PlotStyle->Blue,Mesh->False,BoundaryStyle->{Thickness[0.005],Black}],
ParametricPlot3D[{-(y+5)/3,y,z}, {y,-8,8},{z,-3,3},RegionFunction->Evaluate[regionFcnsQ[{1,2,4}][#1, #2, #3]&],PlotPoints->30,MaxRecursion->4,PlotStyle->Yellow,Mesh->False,BoundaryStyle->{Thickness[0.005],Black}]};

Show[pp,cuts]

signs=Tuples[{-1,1},3]

RegionFunctions=Table[v[[2]] #3<v[[2]] (-0.8 #1)&&
v[[1]] #3<v[[1]] 0.8 #1&& v[[3]] 3 #1<v[[3]] (-(#2+5))&&
insideTorusQ[{#1,#2,#3}],{v,signs}];

piece[i_Integer]:=ParametricPlot3D[{(R+r Cos[ϕ]) Cos[θ],(R+r Cos[ϕ]) Sin[θ],r Sin[ϕ]},{θ,0,2 π},{ϕ,0,2 π},Boxed->False,Axes->False,Lighting->"Neutral",PlotStyle->colors[[i]],RegionFunction->(Evaluate[RegionFunctions[[i,{1,2,3}]]]&),PlotPoints->If[i==1,50,30],MaxRecursion->4,Mesh->False];

planarBorders[i_, cols_:{Black, Black, Black}]:= {
ParametricPlot3D[{x,y, -.8 x}, {x,-8.1,8.1}, {y,-8,8},
 RegionFunction -> (Evaluate[RegionFunctions[[i,{2,3,4}]]]&),PlotPoints->30,MaxRecursion->4, PlotStyle->cols[[1]], Mesh->False],
ParametricPlot3D[{-(y+5)/3,y,z},  {y,-8,8},{z,-3,3}, RegionFunction -> (Evaluate[RegionFunctions[[i,{1,2,4}]]]& ), PlotPoints->30,MaxRecursion->4, PlotStyle->cols[[2]], Mesh->False],ParametricPlot3D[{x,y,.8 x},  {x,-8,8},{y,-8,8}, RegionFunction -> (Evaluate[RegionFunctions[[i,{1,3,4}]]]& ), PlotPoints->30,MaxRecursion->4, PlotStyle->cols[[3]], Mesh->False]};

Show[{piece[1],planarBorders[1,{Green,Blue,Yellow}]},PlotRange->{{-8.2,8.2},{-8.2,8.2},{-3.1,3.1}},Boxed->False]

rules1=Solve[(((R-(Sqrt[(x^2)+(y^2)])))^2)+(z^2)==(r^2)/.z->0.8 x,y];
rules2=Solve[(((R-(Sqrt[(x^2)+(y^2)])))^2)+(z^2)==(r^2)/.z->-0.8 x,y];
rules3=Solve[(((R-(Sqrt[(x^2)+(y^2)])))^2)+(z^2)==(r^2)/.x->-(y+5)/3,y];
cuttingCurves={ParametricPlot3D[{x,y,z}/.z->0.8 x/.rules1,{x,-8,8},PlotStyle->{Black,Thickness[0.01]}],ParametricPlot3D[{x,y,z}/.z->-0.8 x/.rules2,{x,-8,8},PlotStyle->{Black,Thickness[0.01]}],ParametricPlot3D[{x,y,z}/.x->-(1/3) (y+5)/.rules3,{z,-3,3},PlotStyle->{Black,Thickness[0.01]}]};

Show[cuttingCurves,PlotRange->All,Boxed->False,Axes->False]

Show[Table[{piece[i],planarBorders[i]},{i,8}],cuttingCurves,PlotRange->{{-9,9},{-9,9},{-3,3}},Boxed->False]

Show[Table[{piece[i],planarBorders[i,Table[colors[[i]],{3}]]},{i,{1,3,5,7}}],PlotRange->{{-9,9},{-9,9},{-3,3}},Boxed->False,ViewPoint->{-1.77,-2.68,1.08},ViewVertical->{-0.31,-0.16,2.81}]

Show[Table[{piece[i],planarBorders[i,Table[colors[[i]],{3}]]},{i,{2,4,6,8}}],PlotRange->{{-9,9},{-9,9},{-3,3}},Boxed->False,ViewPoint->{2.06,-2.48,1.03},ViewVertical->{0.09,-0.34,2.81}]

.  The Villarceau Circles

p=(2/5); q=(Sqrt[1-(p^2)]);a=(p/q);
circle[ϕ_]:= {1+p Cos[ϕ],0,p Sin[ϕ]};
torus=RotationTransform[θ,{0,0,1}][circle[ϕ]] ;
Show[ParametricPlot3D[torus,{θ,0, π},{ϕ,0, 2π},MeshStyle->GrayLevel[0.3], PlotStyle->Opacity[0.7]],
Graphics3D[{PointSize[Large],Point[{0,0,0}],Thickness[0.008],Red,Line[{{{0,0,0}, {0,10,0}},{{-1,0,-a}, {1,0,a}}}]}], Boxed->False, ViewPoint->{0.2, -2, 0.5}, AxesEdge->{{-1,-1}, {1,-1},{ -1,-1}}, AxesLabel->{"x", " y", None}]

Clear[p,q,u,v,r];
vsol=Simplify[Solve[(((r-1))^2)+(z^2)==(p^2)/.{z->u p,r->(Sqrt[(u^2) (1-(p^2))+(v^2)])},v]]

normSq[v_]:=v.v;
Expand[{normSq[{u q,v,u p}-{0,p,0}]/.(q^2)->1-(p^2)/.vsol[[{2,4}]],
normSq[{u q,v,u p}-{0,-p,0}]/.(q^2)->1-(p^2)/.vsol[[{1,3}]]}]

p=(2/5);q=(Sqrt[1-(p^2)]);a=(p/q);
Show[ParametricPlot3D[torus,{θ,0,2 π},{ϕ,0,2 π},Mesh->None,RegionFunction->(#3<#1 a&)],ParametricPlot3D[RotationTransform[ArcTan[a],{0,-1,0}][{0,-p,0}+{Cos[t],Sin[t],0}],{t,0,2 π},PlotStyle->{Thickness[0.01],Red}],ParametricPlot3D[RotationTransform[ArcTan[a],{0,-1,0}][{0,p,0}+{Cos[t],Sin[t],0}],{t,0,2 π},PlotStyle->{Thickness[0.01],Red}],Boxed->False,Axes->False]

p=(2/5);q=(Sqrt[1-(p^2)]);a=(p/q);ϕval=0;
circle[ϕ_]:={1+p Cos[ϕ],0,p Sin[ϕ]};
torus=RotationTransform[θ,{0,0,1}][circle[ϕ]];
torusPlot=ParametricPlot3D[torus,{θ,0,2 π},{ϕ,0,2 π},MeshStyle->GrayLevel[0.4]];
δTube=2π/100.;rTube=0.05;
vertCircle={Green,
 Tube[Table[{1+p Cos[t],0,p Sin[t]},{t,0.,2 π,δTube}], rTube]};
vilCircle = Tube[Table[
RotationTransform[ArcTan[a],{0,-1,0}][{Cos[t],p+Sin[t],0}], {t,0,2π, δTube}],rTube];
β=ArcTan[q Sin[ϕval],-p-Cos[ϕval]];
ρ=1+p Cos[ϕval];
Show[torusPlot,
Graphics3D[{vertCircle,Red,
t1=GeometricTransformation[vilCircle,RotationTransform[β,{0,0,1}]],
Orange, GeometricTransformation[t1,ReflectionTransform[{0,1,0}]],
Yellow,Tube[Table[{ρ Cos[t],ρ Sin[t],p Sin[ϕval]},{t,0,2π,δTube}],rTube]}],PlotRange->{{-1-p-0.15,1+p+0.15},{-1-p-0.15,1+p+0.15},{-1.15 p,1.15 p}},Boxed->False,Axes->False, ViewAngle->0.3, PlotRegion->{{0,1}, {-.17, 1.23}}]

p=(2/5);q=(Sqrt[1-(p^2)]);a=(p/q);ϕval=0;
circle[ϕ_]:={1+p Cos[ϕ],0,p Sin[ϕ]};
torus=RotationTransform[θ,{0,0,1}][circle[ϕ]];
torusPlot=ParametricPlot3D[torus,{θ,0,2 π},{ϕ,0,2 π},MeshStyle->GrayLevel[0.6]];
δTube=2π/100.;rTube=0.05;
vertCircle={Green,
 Tube[Table[{1+p Cos[t],0,p Sin[t]},{t,0.,2 π,δTube}], rTube]};
vilCircle = Tube[Table[
RotationTransform[ArcTan[a],{0,-1,0}][{Cos[t],p+Sin[t],0}], {t,0,2π, δTube}],rTube];
Manipulate[β=ArcTan[q Sin[ϕval],-p-Cos[ϕval]];
ρ=1+p Cos[ϕval];
Show[torusPlot,
Graphics3D[{vertCircle,Red,
t1=GeometricTransformation[vilCircle,RotationTransform[β,{0,0,1}]],
Orange, GeometricTransformation[t1,ReflectionTransform[{0,1,0}]],
Yellow,Tube[Table[{ρ Cos[t],ρ Sin[t],p Sin[ϕval]},{t,0,2π,δTube}],rTube]}],PlotRange->{{-1-p-0.15,1+p+0.15},{-1-p-0.15,1+p+0.15},{-1.15 p,1.15 p}},Boxed->False,Axes->False, ViewAngle->0.3, PlotRegion->{{0,1}, {-.17, 1.23}}],{{ϕval,0,"ϕ"},-π,π}, SaveDefinitions->True]

.  Beautiful Surfaces

Double Torus

ContourPlot[(x^4)-(x^2)+(y^2)==0,{x,-1.1,1.1},{y,-0.6,0.6},ContourStyle->Thick,PlotPoints->50,AspectRatio->0.6]

Plot3D[(x^4)-(x^2)+(y^2),{x,-1.1,1.1},{y,-0.7,0.7},MeshFunctions->(#3&),Mesh->{{0,(1/5),-(1/5)}},ViewPoint->{1,-2,-1.2}]

ContourPlot[((((x^4)-(x^2)+(y^2)))^2)==(1/25),{x,-1.1,1.1},{y,-1,1},ContourStyle->Thick,AspectRatio->0.6]

ContourPlot3D[((((x^4)-(x^2)+(y^2)))^2)+(z^2)==(1/25),{x,-1.2,1.2},{y,-1,1},{z,-0.4,0.4},PlotPoints->30,BoxRatios->{1,1,0.4},Boxed->False, MeshFunctions->(#3&), MeshStyle->Darker@ Yellow,Axes->False,ContourStyle->Lighter[Yellow]]

Three-Dimensional Cosine

f[x_,y_,z_]:=(cx=Cos[4 x];cy=Cos[4 y];cz=Cos[4 z];
x0=x-(π/4);y0=y-(π/4);z0=z-(π/4);10 (Sin[x0] Sin[y0] Sin[z0]+Sin[x0] Cos[y0] Cos[z0]+Cos[x0] Sin[y0] Cos[z0]+Cos[x0] Cos[y0] Sin[z0])-(7/10) (cx+cy+cz));
ContourPlot3D[Evaluate[f[x,y,z]==9],{x,-4.5,4.5},{y,-4.5,4.5},{z,-4.5,4.5},MaxRecursion->1,Mesh->None,Boxed->False,Axes->False,
ContourStyle->Directive[FaceForm[Orange,Red],Specularity[White,30]],
RegionFunction->(Norm[{##}]<4.5&)]

ContourPlot3D[10 (Cos[x]+Cos[y]+Cos[z])-5.1 (Cos[x] Cos[y]+Cos[y] Cos[z]+Cos[z] Cos[x])==14.6,{x,-2,2},{y,-2,2},{z,-2,2},MaxRecursion->1,MeshFunctions->{#1&,#2&,#3&},Axes->False, Boxed->False, MeshStyle->Orange,ContourStyle->FaceForm[Orange,Cyan]]

ϕ=GoldenRatio;s=1.75;
ContourPlot3D[-(4 ((ϕ^2) (x^2)-(y^2)) ((ϕ^2) (y^2)-(z^2)) ((ϕ^2) (z^2)-(x^2))-(1+2 ϕ) ((((x^2)+(y^2)+(z^2)-1))^2) )==1.1,{x,-s,s},{y,-s,s},{z,-s,s},ContourStyle->White,Boxed->False,Axes->False,SphericalRegion->True,Mesh->5,BoundaryStyle->None,PlotPoints->45,MeshFunctions->(((#1)^2)+((#2)^2)+((#3)^2)&),MeshShading->Function[{i},ColorData[35][i]],MeshStyle->{{Brown,Thickness[0.005]}}]

The Costa Surface

c=WeierstrassInvariants[{0.5,0.5I}][[1]];
e=WeierstrassP[0.5,{c,0}];
Z[z_]=WeierstrassZeta[z,{c,0}];

Costa[z_] := With[{a= z+(( Z[z-(1/2)]-Z[z-(I/2)])/(2 e)),b=((Z[z])/π)-((π(1-I))/(4e)),d=WeierstrassP[z,{c,0}]},
		(π/2){Re[a-b],Im[a+b],(1/(Sqrt[2π]))Log[Abs[((d-e)/(d+e))]]}];

ParametricPlot3D[Evaluate[Costa[u+I v]],{u,0,1},{v,0,1},RegionFunction->(Norm[{#1,#2,#3}]<5.5&),Mesh->None,MaxRecursion->4,PlotPoints->50,Boxed->False,Axes->False,PlotPoints->Automatic]

ParametricPlot3D[Evaluate[Costa[u+I v]],{u,0,1},{v,0,1},PlotRange->{{-2.5,2.5},{-2.5,2.5},{-2.5,2.5}},RegionFunction->(Norm[{#1,#2,#3}]<5&),Mesh->None,MaxRecursion->5,Boxed->False,Axes->False,PlotStyle->{Orange,Specularity[White,20]}]

plot1=ParametricPlot3D[Costa[u+I v],{u,0,1},{v,0,1},PlotRange->All,RegionFunction->(Norm[{#1,#2,#3}]<5&),Mesh->None,MaxRecursion->2];
polygons1=Cases[Normal[Graphics3D[Cases[Normal[plot1],_Polygon,∞],RegionFunction->(Norm[{#1,#2,#3}]≤2.7&)]],_Polygon,∞];
Graphics3D[{EdgeForm[],FaceForm[{Orange,Specularity[White,20]},{Blue,Specularity[White,20]}],polygons1},Boxed->False]

plot2=ParametricPlot3D[Costa[u+I v],{u,0,1},{v,0,1},PlotRange->All,RegionFunction->(Norm[{#1,#2,#3}]<5&),Mesh->None,MaxRecursion->2];
polygons2=Cases[Normal[
Graphics`Mesh`GeometryPlot3D[Cases[Normal[plot2],_Polygon,∞],RegionFunction->(Norm[{#1,#2,#3}]≤2.7&)]],_Polygon,∞];

Graphics3D[{EdgeForm[],FaceForm[{Orange,Specularity[White,20]},{Blue,Specularity[White,20]}],polygons2},Boxed->False, ViewAngle->0.34]

tor[u_,v_]:={Sin[2 π (u+0.5)] (2+Cos[v 2 π]),Sin[-2 π v],-Cos[2 π (u+0.5)] (2+Cos[2 π v])};

radius[_]=2.7;
radius[0.|0] = 3.02;
radius[0.1]=2.93;
radius[0.2]=2.76;
radius[0.3]=2.68;

Morph[t_] := ParametricPlot3D[
 (1-t) tor[u,v]+t Costa[u+I v],{u,0,1},{v,0,1},PlotRange->All,RegionFunction->(Norm[{#1,#2,#3}]<5&),Mesh->None,MaxRecursion->2];

polygons[t_]:=Cases[Normal[Graphics`Mesh`GeometryPlot3D[Cases[Normal[Morph[t]],_Polygon,∞],RegionFunction->(Norm[{#1,#2,#3}]≤radius[t]&)]],_Polygon,∞];

finalMorph[t_, opts___]:=finalMorph[t, opts]=
Graphics3D[{EdgeForm[],FaceForm[{Orange,Specularity[White,20]},{Blue,Specularity[White,20]}],polygons[t]},opts,ImageSize->200,Boxed->False];

Monitor[Do[finalMorph[t],{t,0,1,0.1}],t]

Manipulate[finalMorph[t],{t,0,1,0.1}]

GraphicsGrid[{{finalMorph[0.],finalMorph[0.2]},{finalMorph[0.4],finalMorph[0.6]},{finalMorph[0.8],finalMorph[1.]}},Spacings->-70]

.  A Fractal Tetrahedron

cols={Red, Green,Blue, Yellow, Orange, Cyan};
fractalize[{c_Color,{p_,q_,r_}}]:=Module[{pq=((p+q)/2),qr=((r+q)/2),pr=((p+r)/2),
new=(1/3) (p+q+r)+((Normalize[(q-p) \[Cross](r-p)] Norm[p-q])/(Sqrt[6]))},
		{
{c,Polygon[#]}&/@{{p,pq,pr},{pq,q,qr},{pr,qr,r}},{Color[i],Polygon[#]}&/@ {{pr,pq,new},{pq,qr,new},{qr,pr,new}}}]

KochPlanet[n_,opts___]:=(i=1;
vertices=N[{{((Sqrt[3])/3),0,0},{-((Sqrt[3])/6),0.5,0},{-((Sqrt[3])/6),-0.5,0}}];
triangle={Color[1],Polygon[vertices]};
tetrahedron={Thickness[0.0001],(Line[{{0,0,(1/(Sqrt[6]))},#}]&)/@vertices};
(Graphics3D[{tetrahedron,
Nest[(i++; #/.{Color[j_],Polygon[v_]}:>fractalize[{Color[j],v}])&,triangle,n]},opts,ImageSize->150,Lighting->"Neutral",ViewPoint->{2,0.3,1.3},Boxed->False])/. Color[j_]:>cols[[j]])

GraphicsRow[{KochPlanet[1],KochPlanet[2],KochPlanet[2,ViewPoint->{ 1(Sqrt[3]) Cos[322.6°]/2, Sin[322.6°],-0.1 }]}]

(∑_(n=0)^∞)(1/96) (Sqrt[2]) ((((6/8)))^n)

KochPlanet[n_,opts___]:=(i=1;tetrahedron=({Color[i],Polygon[#]}&)/@N[
   {{{-1,-1,-1},{1,-1,1},{-1,1,1}},{{-1,-1,-1},
{1,1,-1},{1,-1,1}},{{1,-1,1},{1,1,-1},
{-1,1,1}},{{-1,-1,-1},{-1,1,1},{1,1,-1}}}];Graphics3D[{{FaceForm[],Cuboid[{-1,-1,-1},{1,1,1}]},{Nest[(i++;#/.{Color[j_],Polygon[v_]}:>fractalize[{Color[j],v}])&,tetrahedron,n]}}/.Color[j_]:>cols[[j]],opts,Lighting->"Neutral",ViewPoint->{-1.65,1.4,0.9},BoxRatios->{1,1,1},Boxed->False])

GraphicsGrid[Map[KochPlanet, {{0,1},{2,3}},{2}]]

KochPlanet[5]