Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2011

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

Search the Archive

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]
> 




  • Prev by Date: why MakeExpression acts differently
  • Next by Date: Re: NonlinearModelFit and "ANOVATable" and "ParameterConfidenceIntervalTable"
  • Previous by thread: Re: applying a real texture in Mathematica
  • Next by thread: Re: applying a real texture in Mathematica