Public Pastes

100 nearest stars

By: Matthen on Jan 19th, 2012  |  syntax: None  |  size: 0.83 KB  |  hits: 250  |  expires: Never
download  |  raw  |  embed  |  report abuse
Copied
  1. stars = AstronomicalData["StarNearest100"];
  2. pts = AstronomicalData[#, "Position"] & /@ stars;
  3. clrs = ColorData["BlackBodySpectrum"][
  4.      AstronomicalData[#, "EffectiveTemperature"]] & /@ stars;
  5. clrs = Map[If[TrueQ[Head[#] == Blend], White, #] &, clrs];
  6. radii = AstronomicalData[#, "Radius"] & /@ stars;
  7. radii = Map[If[NumberQ[#], #, radii[[2]]] &, radii];
  8. frame[t_] := Module[{ptsn},
  9.   ptsn = Map[
  10.     RotationMatrix[4 Pi t, {0.1, 1, 1}].RotationMatrix[
  11.        2 Pi t, {1, 0, 0}].# &, pts];
  12.  
  13.   Graphics3D[{Sphere[{0, 0, 0}, 10^8],
  14.     Table[{clrs[[i]],
  15.       Sphere[ptsn[[i]], Tanh[radii[[i]]*2 (0.1^9)] 10 ^16]},
  16.      {i, 100}]
  17.     }, Background -> Black, Lighting -> {{"Ambient", White}},
  18.    PlotRange -> Max[Map[Norm, pts]], ImageSize -> 300,
  19.    ViewPoint -> {2, 0, 0}, Boxed -> False]
  20.   ];
  21. Manipulate[frame[t],{t,0,1}]
create a new version of this paste RAW Paste Data