applying a real texture in Mathematica

*To*: mathgroup at smc.vnet.net*Subject*: [mg121307] applying a real texture in Mathematica*From*: Roger Bagula <roger.bagula at gmail.com>*Date*: Thu, 8 Sep 2011 05:27:36 -0400 (EDT)*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com

The idea is to use vertex data in ListSurfacePlot3D[] to give the surface a rough ( or hairy) look. I call this the Hairy Asteriod. The cusp lines on the surface are where ListSurfacePlot3D[] "flames" out the worst. Clear[x1, y1, z1, g1, g, ga, gb, t, p, d, a] (* surface with cusps : asteroid of rotation*) x1 = Cos[t]^3*Sin[p]; y1 = Sin[t]^3*Sin[p]; z1 = Cos[p]; w1 = {x1, z1, y1}; g = Flatten[Table[w1, {t, 0, Pi, Pi/50}, {p, -Pi, Pi, 2*Pi/50}], 1]; Length[g] (* texture generating array*) d = 0.01; a[0] = {d, d, d} a[2] = {d, d, -d} a[3] = {d, -d, d} a[4] = {-d, d, d} a[5] = {-d, d, -d} a[6] = {-d, -d, d} a[7] = {-d, d, -d} a[8] = {-d, -d, -d} (* applying the texture to the surface*) g1 = Table[g[[n]] + a[Mod[n, 8]], {n, 1, Length[g]}]; ga = ListSurfacePlot3D[g1, MaxPlotPoints -> 200, Axes -> False, Boxed -> False, Mesh -> None, PlotStyle -> {Black, Specularity[White, 20]}] gb = ParametricPlot3D[w1, {t, 0, Pi}, {p, -Pi, Pi}, PlotPoints -> 50, PlotRange -> All, PlotStyle -> {LightBlue, Specularity[White, 30]}, Axes -> False, Boxed -> False, Mesh -> False] gw = Show[{ga, gb}, PlotRange -> All] Export["HairyAsteriod.3ds", gw] Export["HairyAsteriod.obj", gw] Export["HairyAsteriod.stl", gw]