Anatomische Strukturen in Skulpturen verwandeln: Neu in Wolfram Language 11

Anatomische Strukturen in Skulpturen verwandeln

Dank hochauflösender 3D-Modelle von menschlichen anatomischen Strukturen können die leistungsstarken Graphiken und Be- und Verarbeitungsfunktionalitäten in Version 11 zur programmatischen Erzeugung anatomiebezogener moderner Skultpuren eingesetzt werden.

Antony Gormleys Kunstwerke können dabei als Inspiration dienen (http://www.antonygormley.com/sculpture/chronology).

Den kompletten Wolfram Language-Input zeigen

In[1]:=

WikipediaData["Antony Gormley", "ImageList"] // 
 Select[#, 
   Length[Union[#]]/Length[#] &[ImageData[#][[1, 1]]] > 0.8 &] &

Out[1]=

Laden Sie eine originalgetreue Darstellung des menschlichen Körpers.

In[2]:=

human = AnatomyData[Entity["AnatomicalStructure", "Skin"], 
  "MeshRegion"]

Out[2]=

Mit der Funktionalität zum Erstellen und Berechnen von Regionen können Skulpturen aller Art und unterschiedlicher Form völlig unkompliziert gestaltet werden.

Den kompletten Wolfram Language-Input zeigen

In[3]:=

pts = MeshCoordinates[human];
nf = Nearest[pts];
color := Directive[GrayLevel[RandomReal[{0.5, 0.7}]], 
  Specularity[RandomColor[], RandomInteger[{10, 20}]]]

In[4]:=

With[{dode = N[PolyhedronData["Dodecahedron"][[1]]]},
 ballToDodecahedron[Ball[p_, r_]] := 
  Translate[
   Scale[Rotate[dode, RandomReal[{-Pi, Pi}], 
     RandomReal[{-1, 1}, 3], {0, 0, 0}], r], p]]

In[5]:=

GraphicsGrid[
  Partition[#, 
     4] &@{Graphics3D[{EdgeForm[], color, 
      Table[BoundingRegion[
        nf[RandomChoice[pts], RandomInteger[{100, 1000}]], 
        "MinCuboid"], {200}]}],
    Graphics3D[{EdgeForm[], color, 
      Table[BoundingRegion[
        nf[RandomChoice[pts], RandomInteger[{100, 1000}]], 
        "FastOrientedCuboid"], {250}]}],
    Graphics3D[{color, EdgeForm[], 
      Table[Show[
          BoundingRegion[
           RandomChoice[
            nf[RandomChoice[pts], RandomInteger[{100, 2000}]],
            RandomInteger[{4, 12}]], "MinConvexPolyhedron"]][[
         1]] /. _Directive :> {}, {600}]}],
    Graphics3D[{color, EdgeForm[], 
      Table[ballToDodecahedron@
        BoundingRegion[
         RandomChoice[nf[RandomChoice[pts], RandomInteger[{100, 600}]],
          RandomInteger[{4, 12}]], "FastBall"], {300}]}],
    Graphics3D[{color, 
      Table[BoundingRegion[
        RandomChoice[
         nf[RandomChoice[pts], RandomInteger[{100, 600}]],
         RandomInteger[{4, 12}]], "FastBall"], {500}]}],
    Graphics3D[{color, 
      Table[
       BoundingRegion[
        RandomChoice[nf[RandomChoice[pts], RandomInteger[{100, 2000}]],
         RandomInteger[{4, 12}]], "FastEllipsoid"], {350}]}],
    Graphics3D[{color, EdgeForm[], 
      Table[Cylinder[{#, nf[#, RandomInteger[{2000, 5000}]][[-1]]} &[
         RandomChoice[pts]],
        RandomReal[{5, 25}]], {600}]}],
    Module[{pts2 = RandomSample[pts, 6000], nf2},
     nf2 = Nearest[pts];
     Graphics3D[{color, EdgeForm[], CapForm["Round"],
       Cylinder[{#, nf2[#, 100][[-1]]}, 6] & /@ 
        RandomSample[pts2]}]]}, Spacings -> {-150, Automatic}, 
  ImageSize -> Full
  ] // Rasterize[#, "Image", ImageSize -> {400, 400}] &

Out[5]=

Klassischer wirkende Kunstwerke können durch die Anwendung einer Rotations- und Streckungstransformation auf die Arme und Beine erzielt werden. So entstehen Engel-ähnliche Skultpuren.

Den kompletten Wolfram Language-Input zeigen

In[6]:=

nonlinearTransform3D[expr_, g_] :=
 
 Module[{gD, inv, newNormal, newVertices, newNormals}, 
  gD[x_, y_, z_] = 
   Compile[{x, y, z}, Evaluate[D[g[{x, y, z}], {{x, y, z}}]]];
  inv[m_] := 
   With[{im = Inverse[m]}, 
    If[Head[im] === Inverse, m, PseudoInverse[m]]];
  newNormal[{vertex_, normal_}] := 
   Quiet[With[{m = inv[Transpose[gD[vertex]]]}, 
     If[Sign[Det[m]] == -1, -1, 1] m.normal]]; 
  expr /. {GraphicsComplex[vertices_, body_, a___, 
      VertexNormals -> normals_, 
      b___] :> (newVertices = g /@ vertices; 
      newNormals = newNormal /@ Transpose[{vertices, normals}]; 
      GraphicsComplex[newVertices, body, a, 
       VertexNormals -> newNormals, b])}]

In[7]:=

doubleTwist[{x_, y_, z_}] :=
 
 With[{h = 1000, w = 180, H = 1300, \[Xi] = 600, \[Kappa] = 150},
  With[{\[CurlyPhi] = 
     6 Pi If[z > h || (z > \[Xi] && Sqrt[x^2] > w), 0, 
       Cos[Pi/2 (h - z)/h]],
    \[CurlyTheta] = -1.6 Pi If[(z > \[Xi] && Sqrt[x^2] < w) || 
        z < \[Xi], 0, Cos[Pi/2 (w - x)/w]],
    f = Piecewise[{{1, z > h}, {1 + (h - z)/h, z < h}}],
    g = If[(z > \[Xi] && Sqrt[x^2] < w) || z < \[Xi], 1, 
      1 + (Sqrt[x^2] - w)/\[Kappa]]}, {{g, 0, 0}, {0, 
       Cos[\[CurlyTheta]], 
       Sin[\[CurlyTheta]]}, {0, -Sin[\[CurlyTheta]], 
       Cos[\[CurlyTheta]]}}.({{f Cos[\[CurlyPhi]], f Sin[\[CurlyPhi]],
           0}, {-f Sin[\[CurlyPhi]], f Cos[\[CurlyPhi]], 0}, {0, 0, 
          1}}.{x, y, z} - {0, 0, H}) + {0, 0, H}]]

In[8]:=

smoothHuman = Entity["AnatomicalStructure", "Skin"]["Graphics3D"];

In[9]:=

Show[nonlinearTransform3D[smoothHuman, doubleTwist], 
 ViewPoint -> {-1, -2, 0}, Method -> {"ShrinkWrap" -> True}]

Out[9]=

Wolfram Language™

Anatomische Strukturen in Skulpturen verwandeln

Verwandte Beispiele