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

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 !

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


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.

• Hmmm, it's crashing Mathematica 7.0. I think it's related to the rescale thing. – Cham Aug 4 '15 at 15:54
• @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. – Michael E2 Aug 4 '15 at 16:09
• 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. – Cham Aug 4 '15 at 16:14
• @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. – Michael E2 Aug 4 '15 at 16:26
• 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. – Cham Aug 4 '15 at 16:36