Re: applying a real texture in Mathematica
- To: mathgroup at smc.vnet.net
- Subject: [mg121316] Re: applying a real texture in Mathematica
- From: Yves Klett <yves.klett at googlemail.com>
- Date: Fri, 9 Sep 2011 05:51:12 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- References: <j4a21t$441$1@smc.vnet.net>
Just a suggestion, but I am not particularly fond of mathgroup code that Export(s) or modifies files without really good reason. This might mess up someone's files or leave undesired (large) files in whatever directory you happen to work in. So I'd recommend commenting out the Export statements unless you really work with the exported stuff later on in the same post. Regards, Yves Am 08.09.2011 11:31, schrieb Roger Bagula: > 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] >