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[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}],
1];
Length[g]
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]