MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

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]




  • Prev by Date: Re: Output complex numbers in polar (exponential) form?
  • Next by Date: Re: two coupled differential equations
  • Previous by thread: Label period, instead of scale, for DWT
  • Next by thread: Re: applying a real texture in Mathematica