Re: 3D-Plots "aufwickeln"

[Jens-Peer Kuska <kuska@XXXXXXX.de>]

Hallo,

n"o, sollte es das ? Ich nehme mal an mit 3D-Plots meinst Du
eine SurfaceGraphics[], die man mit

gg =
    Plot3D[Sin[x]*Cos[2*y], {y, 0, 2Pi}, {x, 0, 2Pi}, PlotPoints -> 60]

erstellen k"onnte. Mit "aufwickeln" k"onnte gemeint sein, dass
Du die H"ohen der SurfaceGraphics[] als St"orungen auf eine
Torus-Fl"ache aufbringen willst. Nat"urlich skaliert mit scale.
Der ungest"orte Torus sollte die beiden Radien r1 und r2 haben.

So etwas k"onnte man also mit

toTorus[{u_, v_, z_}, scale_?NumericQ, r1_?NumericQ, r2_?NumericQ] := 
  With[{rr = r2 + scale*z}, {(r1 + Cos[u]*rr)*Cos[v], (r1 +
Cos[u]*rr)Sin[v], 
      rr*Sin[u]}] 

und

Show[Graphics3D[gg] /. Polygon[pnts_] :> Polygon[toTorus[#, 1, 4, 1] &
/@ pnts]]

machen. Es s"ahe  nat"urlich wesentlich schicker aus, wenn man das auch
noch bunt
machen w"urde mit

Show[Graphics3D[gg] /. Polygon[
        pnts_] :> {SurfaceColor[Hue[(Last[Plus @@ pnts]/Length[pnts] +
1)/2]],
         Polygon[toTorus[#, 1, 4, 1] & /@ pnts]}]

Man kann sich das St"oren der Fl"ache auch sparen und einfach nur die
bunten
Polygone nehmen, was zwar nicht ganz soooo schick ist 

Show[Graphics3D[gg] /. Polygon[pnts_] :> {EdgeForm[], 
        SurfaceColor[Hue[(Last[Plus @@ pnts]/Length[pnts] + 1)/2]], 
        Polygon[toTorus[Append[Take[#, 2], 0], 1, 4, 2] & /@ pnts]}]

aber wesenlich besser zu erkennen.

Gruss
  Jens

Clemens Frey wrote:
> 
> Hallo Mathematica-Freunde,
> 
> gibt es eine Standard-Lösung, um 3D-Plots auf
> Tori oder Kugeln "aufzuwickeln" ?
> 
> Vielen Dank
> 
> Clemens