Revision 4d7eeea6-087f-487e-a01d-dc66a57b8add - Code Golf Stack Exchange

#Mathematica

This generates a *Voronoi* mesh from a random number (5-25) of random points (in the square region bound by (-1,-1) and (1,1)). 
Whereas, in an earlier version, I simply applied image effects to the mesh (most notably, embossing), this grabs the polygon primitives that comprise the mesh and then transforms them into polyhedra. Each polyhedron is then translated outwards on the xy plane. The magnitude of the translation varies as a function of the distance between the polyhedron's original generating random point and the center of the screen. This results in crevices between the pieces.

Ideally there should be fissures and irregularities in the polyhedra. The edges of the figures would also be jagged rather than straight.

The images below are 250 by 250 pixels; the ones produced by the code are 500 by 500.

 z[23456]

[![pic1][1]][1]


----------

 z[123]

[![pic2][2]][2]
----------


----------


Code
----

 ClearAll[f,g, polys,q,z]
 a=Axes->False;
 b=PlotRange->Automatic(*{{-1.5,1.5},{-1.5,1.5},{-.2,.2}}*);
 c=Boxed->False;
 
 f[nPts_]:=Module[{pts,\[ScriptCapitalR],data},
 pts=RandomReal[{-1,1},{nPts,2}];
 \[ScriptCapitalR]=VoronoiMesh[pts,ImageSize->Medium,PlotTheme->"Lines",Axes->True,AxesOrigin->{0,0}];
 data=Join@@(MeshPrimitives[\[ScriptCapitalR],2][[All,1]]/.{x_,y_}:> {{x,y,0},{x,y,.04}});
 MeshPrimitives[\[ScriptCapitalR],2]]

 g[poly_]:=
 Module[{v=Join@@(poly[[1]]/.{x_,y_}:> {{x,y,0},{x,y,-.08}}),nVertices,n=1,points={}},
 nVertices=Length[v]/2;
 p=Select[Range@(2*nVertices),#]&/@{OddQ,EvenQ};
 While[n<nVertices+1,AppendTo[p,{p[[1,n]],p[[2,n]],p[[2,If[n+1<nVertices+1,n+1,1]]],p[[1,If[n+1<nVertices+1,n+1,1]]]}];n++]; GraphicsComplex[v,Polygon[p]]]
 
 polys[pts_]:=Module[{\[ScriptCapitalR],data},
 \[ScriptCapitalR]=VoronoiMesh[pts,ImageSize->Medium,PlotTheme->"Lines",Axes->True,AxesOrigin->{0,0}];
 data=Join@@(MeshPrimitives[\[ScriptCapitalR],2][[All,1]]/.{x_,y_}:> {{x,y,0},{x,y,.04}});
 MeshPrimitives[\[ScriptCapitalR],2]]

 q[n_,points_,pgons_]:=FirstCase[points,{x_,y_}/;RegionMember[pgons[[n]],{x,y}]:> {x,y,0}]
 
 z[seed_]:=
 Module[{pts,pts3D,a, b,c,gt},
 a=Axes->False;
 b=PlotRange->Automatic;
 c=Boxed->False;
 
 SeedRandom[seed];
 nPts=RandomInteger[{5,25}];
 pts=RandomReal[{-1,1},{nPts,2}];
 pts3D=pts/.{x_,y_}:>{x,y,.0};
 polygons=polys[pts];
 gcomplexes=g/@polygons;
 centerPt=(Mean/@(PlotRange/.AbsoluteOptions[Graphics3D[{gcomplexes,Blue,Point@pts3D},a,b,c]]))/.{x_Real,y_,_}:>{x,y,0};
 gt=Graphics3D[{Lighter@Brown,
 GeometricTransformation[{g[polygons[[#]]]},
 TranslationTransform[(q[#,pts,polygons]-centerPt)/10]]&/@Range@nPts},a,b,c,ViewPoint->{0.,-1,1.5},Background->Gray,ImageSize->1200];
 
 ImageTrim[Rasterize[gt],{{250,250},{750,750}}]]


 [1]: https://i.sstatic.net/plpkM.jpg
 [2]: https://i.sstatic.net/r77k3.jpg