       Re: applying a real texture in Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg121310] Re: applying a real texture in Mathematica
• From: Roger Bagula <roger.bagula at gmail.com>
• Date: Fri, 9 Sep 2011 04:05:52 -0400 (EDT)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <j4a21t\$441\$1@smc.vnet.net>

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)*(6.75/5)
y1 = Cos[t]*(2 + Exp[1 - Sin[p]]/Exp)*(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}],
1];
Length[g]
d = 0.05;
a = {d, d, d}
a = {d, d, -d}
a = {d, -d, d}
a = {-d, d, d}
a = {-d, d, -d}
a = {-d, -d, d}
a = {-d, d, -d}
a = {-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