In[]:=
Needs["Developer`"]dim=150;st=dim/10;MakeColor[tract:{{_?NumberQ,_?NumberQ,_?NumberQ}..}]:=Block[{dirs},dirs=Abs[Differences[tract]];ToPackedArray[Normalize[#]&/@Mean[{Prepend[dirs,dirs[[1]]],Append[dirs,dirs[[-1]]]}]]]MakeColor[tracts_]:=MakeColor/@tractsMakeTracts[n_,len_,size_]:=ToPackedArray@Accumulate@Prepend[stNormalize/@RandomReal[{-1,1},{#,3}],sizeRandomReal[dim,3]]&/@RandomInteger[len,n]PlotTracts[{n_,len_,size_},fun_]:=Block[{tr,col,opts},tr=MakeTracts[n,len,size];col=MakeColor@tr;opts=Sequence[{PlotRange->{{-5,dim+5},{-5,dim+5},{-5,dim+5}},Axes->True,BoxRatios->dimsize,ImageSize->800,SphericalRegion->True,Lighting->"Accent",Background->Lighter@Gray,Method->{"TubePoints"->{5,2}}}];Graphics3D[{CapForm["Square"],JoinForm["Miter"],Scale[fun[tr,VertexColors->col],1/size,{0,0,0}]},opts]]
In[]:=
n=2000;len={50,100};size={6,3,3};p1=PlotTracts[{n,len,size},Line];//AbsoluteTimingp2=PlotTracts[{n,len,size},Tube];//AbsoluteTiming
Out[]=
{0.423096,Null}
Out[]=
{0.401294,Null}
In[]:=
p1
In[]:=
p2