1
$\begingroup$

I would like to add a fading color to all the 3D lines I'm drawing with the code below, but I'm having difficulties with implementing the idea. The curves are starting on a unit sphere, and extend in both directions : to a central sphere of radius omega < 1, and to the exterior of the circle. The curves should be dark blue on the surface of the sphere, and gently fade away, at a great distance from the sphere, instead of a simple cut.

So here's the code :

alpha=40Pi/180;

omega=2Pi (10000)/(299792458*0.001);

Mu0={Sin[alpha],0,Cos[alpha]};

r[x_,y_,z_]:=Sqrt[x^2+y^2+z^2]

Bdipolaire[x_,y_,z_]:=3(Mu0.{x,y,z}){x,y,z}/r[x,y,z]^5-Mu0/r[x,y,z]^3

NormeB[x_,y_,z_]:=Sqrt[Bdipolaire[x,y,z].Bdipolaire[x,y,z]]

Bx[x_,y_,z_]:={1,0,0}.Bdipolaire[x,y,z]
By[x_,y_,z_]:={0,1,0}.Bdipolaire[x,y,z]
Bz[x_,y_,z_]:={0,0,1}.Bdipolaire[x,y,z]

Angles:=
  {0.1972815, 0.1988315,0.2014215,0.2049765,0.2090015,0.2127115,0.2151015,
   0.2151015,0.2116515,0.2031515,0.1692915,0.1687315,0.1705015,0.1723815,
   0.1742015,0.1759465,0.1776115,0.1792415,0.1808415,0.1824015,0.1839215,
   0.1854085,0.1868585,0.1882765,0.1897015,0.1911415,0.1926035,0.1940415,
   0.1953345,0.1963365}

NCourbes:=Length[Angles]

theta[n_]:= Angles[[n]]

phi[n_]:=(n-1)2Pi/NCourbes

CourbeMagnetique[n_]:=NDSolve[{
    x'[s]==Bx[x[s],y[s],z[s]]/NormeB[x[s],y[s],z[s]],
    y'[s]==By[x[s],y[s],z[s]]/NormeB[x[s],y[s],z[s]],
    z'[s]==Bz[x[s],y[s],z[s]]/NormeB[x[s],y[s],z[s]],

    x[0]==(Sin[theta[n]]Cos[phi[n]]Cos[alpha]+Cos[theta[n]]Sin[alpha]),
    y[0]==Sin[theta[n]]Sin[phi[n]],
    z[0]==(Cos[theta[n]]Cos[alpha]-Sin[theta[n]]Cos[phi[n]]Sin[alpha])
    }, 
    {x,y,z}, {s,-10,10},
    Method->Automatic,MaxSteps->10000000,
    StoppingTest->(Sqrt[x[s]^2+y[s]^2+z[s]^2]<omega)]

Do[CourbeMagnetique[n],{n,1,NCourbes}]

Smin[n_]:=(x/.CourbeMagnetique[n])[[1]][[1]][[1]][[1]]
Smax[n_]:=(x/.CourbeMagnetique[n])[[1]][[1]][[1]][[2]]

GraphicSize:=1.5

GrapheMagnetique[n_]:=
  ParametricPlot3D[
    Evaluate[{x[s],y[s],z[s]}/.CourbeMagnetique[n]],
    {s,Smin[n],Smax[n]},
    PlotStyle->{Directive[AbsoluteThickness[1]],Blue},
    MaxRecursion->7,PerformanceGoal->"Quality"]

CercleLumiere:=
   ParametricPlot3D[{Cos[p],Sin[p],0},{p,0,2Pi},
     PlotStyle->{Directive[Thick,RGBColor[0.40,0.70,0.40]]},
     PerformanceGoal->"Quality"]

AxesCartesiens=
  {Line[GraphicSize {{-1,0,0},{1,0,0}}],
   Line[GraphicSize {{0,-1,0},{0,1,0}}],
   Line[GraphicSize {{0,0,-1},{0,0,1}}]};

AxeMagnetique=
   Line[(2/3){{-Sin[alpha],0,-Cos[alpha]},{Sin[alpha],0,Cos[alpha]}}];

AxeRotation=Line[(1/3){{0,0,-1},{0,0,1}}];

AxesReference:=
  Graphics3D[{
    {Thin,GrayLevel[0.7],Dashed,AxesCartesiens},
    {Thick,Blue,AxeMagnetique},
    {Thick,RGBColor[0.40,0.70,0.40],AxeRotation}}]

Pulsar:=Graphics3D[Sphere[{0,0,0}, omega]]

Graphique=
  Show[
    Table[GrapheMagnetique[n],{n,1,NCourbes}],CercleLumiere,AxesReference,Pulsar,
    PlotRange->{
      {-GraphicSize,GraphicSize},
      {-GraphicSize,GraphicSize},
      {-GraphicSize,GraphicSize}},
    Boxed->False,Axes->False,Lighting->"Neutral",
    SphericalRegion->True,ViewPoint->{0,0,1}]

Here's a picture to show what the code above is currently doing

my picture

I was thinking about adding a shade like the one below (colors to be edited afterward), to be used instead of the current Blue directive, but I don't know how to add it (because of the "s" and "n" variables) :

Couleur1 = RGBColor[0,0,1];
Couleur2 = RGBColor[1,0,0];
Couleur3 = RGBColor[0,1,0];

CouleurLigne[s_, n_] := Blend[{Couleur1,Couleur2,Couleur3},  Rescale[s, {Smin[n], Smax[n]}]]

So what should be the simplest way of replacing the Blue directive to the shade defined above ? Take note that I'm using Mathematica 7.0.

EDIT : I was playing with the answer to a question I asked there : Colors on a 3D curve not working, but the "n" variable is giving me an headache !

$\endgroup$
1
$\begingroup$

Is ColorFunction what you want? (The input is automatically rescaled from 0 to 1, so Rescale is unnecessary; see also ColorFunctionScaling.)

GrapheMagnetique[n_] := 
 ParametricPlot3D[
  Evaluate[{x[s], y[s], z[s]} /. CourbeMagnetique[n]], {s, Smin[n], 
   Smax[n]}, PlotStyle -> {Directive[AbsoluteThickness[1]](*,Blue*)}, 
  ColorFunction -> (Blend[{Couleur1, Couleur2, Couleur3}, #4] &), 
  MaxRecursion -> 7, PerformanceGoal -> "Quality"]

Mathematica graphics

I changed your PlotRange to PlotRange -> All show the color gradient. The one specified in the OP's code is too small to show the color change.

$\endgroup$
  • $\begingroup$ Hmmm, it's crashing Mathematica 7.0. I think it's related to the rescale thing. $\endgroup$ – Cham Aug 4 '15 at 15:54
  • $\begingroup$ @Cham I don't have V7 to test. It seems like it still works the same (reference.wolfram.com/legacy/v7/ref/ColorFunctionScaling.html). In V10, with your original Rescale code, it runs for a very long time (I didn't wait long enough to see if it would finish). But the code above runs in a few seconds. Sorry, I can't really think of what to try. $\endgroup$ – Michael E2 Aug 4 '15 at 16:09
  • $\begingroup$ The problem is to take care of the "n" variable. Without it (i.e. your suggestion) gives a weird output (if Mathematica doesn't crash) ; the lines are "blinking" while I move around the 3D graphics, and the colors are changing from black to color shades in a weird way. It feels wrong. I'm pretty sure it's related to the Rescale option. $\endgroup$ – Cham Aug 4 '15 at 16:14
  • $\begingroup$ @Cham I don't think I understand what you want with n. These options give me the same plot: ColorFunction -> CouleurLigne[#4, n] &), ColorFunctionScaling -> False. The only use of n in CouleurLigne is to scale the parameter s from 0 to 1 over the domain, which is exactly what the default does (in my answer). -- The blinking sounds weird. I tend to associate it with a memory leak leading to an imminent crash. I get no such behavior. $\endgroup$ – Michael E2 Aug 4 '15 at 16:26
  • $\begingroup$ The "n" variable allows to define a different color shade for each curve. The blinking colors may be some weakness of Mathematica 7.0 ? It's the first time I'm running into a crashing bug with this version. $\endgroup$ – Cham Aug 4 '15 at 16:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.