MathGroup Archive 2011

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

Search the Archive

Re: applying a real texture in Mathematica

  • To: mathgroup at
  • Subject: [mg121310] Re: applying a real texture in Mathematica
  • From: Roger Bagula <roger.bagula at>
  • Date: Fri, 9 Sep 2011 04:05:52 -0400 (EDT)
  • Delivered-to:
  • References: <j4a21t$441$>

Cusps cause the worst flaming in ListSurfacePlot3D[].
A relatively smooth surface like that of a ring with flattened inside
shows the most texture flaming on the highest curvature
and the best texture on the flattest parts.
A Sinoid ring with a texture:
Clear[x1, y1, z1, g1, g, ga, gb, t, p, d, a]
x1 = Sin[t]*(2 + Exp[1 - Sin[p]]/Exp[2])*(6.75/5)
y1 = Cos[t]*(2 + Exp[1 - Sin[p]]/Exp[2])*(6.75/5)
z1 = Cos[p]
w1 = {x1, z1, y1};
g = Flatten[Table[w1, {t, -Pi, Pi, 2*Pi/50}, {p, -Pi, Pi, 2*Pi/50}],
d = 0.05;
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}
g1 = Table[g[[n]] + a[Mod[n, 8]], {n, 1, Length[g]}];
ga = ListSurfacePlot3D[g1, MaxPlotPoints -> 250, Axes -> False,
  Boxed -> False, Mesh -> None,
  PlotStyle -> {Black, Specularity[White, 20]}]
gb = ParametricPlot3D[w1, {t, -Pi, Pi}, {p, -Pi, Pi},
  PlotPoints -> 65, PlotRange -> All,
  PlotStyle -> {Orange, Specularity[White, 10]}, Axes -> False,
  Boxed -> False, Mesh -> False]
Export["Sinoidring.3ds", gb]
Export["Sinoidring.obj", gb]
Export["Sinoidring.stl", gb]
gw = Show[{ga, gb}, PlotRange -> All]
Export["HairySinoidring250.3ds", gw]
Export["HairySinoidring250.obj", gw]
Export["HairySinoidring250.stl", gw]

  • Prev by Date: Re: Quit versus Clear["Global`*"]
  • Next by Date: Re: How to generate report with Mathematica script from command line
  • Previous by thread: applying a real texture in Mathematica
  • Next by thread: Re: applying a real texture in Mathematica