2
$\begingroup$

I want to label the points displayed in 3D within a Manipulate expression with arbitrary text. My code is as follows:

data2 = {{0.000, 0.000, 0.000}, {-1.612, 8.077, -2.474}, {-19.599, 
186.849, -246.583}, {-29.000, -19.499, 
12.157}, {-1.646, -1.375, -3.842}, {3.127, -19.235, 
15.660}, {167.744, 834.512, -122.686}, {-5.353 , 9.547, 
1.096}, {13.369, 634.519, 82.506}, {36.150, 235.772, 
26.543}, {5.481, 28.657, 30.211}, {22.354, 58.173, 
18.471}, {-206.890, -495.847, -267.081}, {-13.242 , 26.759, 
16.267}, {-17.712 , 40.444, 27.470}, {-66.567, 35.256, 
15.966}, {-1224.806, 
3234.005, -1669.329}, {-1.546, -1.183, -3.769}, {-0.057, -5.943, 
0.488}, {-7.430 , 2.113, 0.950}, {-6.506 , 1.642, 
4.870}, {1.910, -8.647, -3.912}, {6.213, 8.314, -1.729}, {10.287, 
5.021, -3.269}, {6.468, -2.746, 
11.114}, {14.243, -4.268, -3.780}, {-24.260 , 25.880, 
19.125}, {-24.952, -8.886, -8.766}, {45.832, -12.825, 
18.049}, {7.807, -14.872, 2.621}, {68.981, 
31.332, -117.728}, {20.933, -5.840, -12.357}, {-237.661, -92.652,
-50.329}, {4.354, 3.396, 429.965}, {1184.687, -1394.076, 
1847.449}, {47.862, 51.402, 
60.959}, {-172.829, -36.515, -302.153}, {4.898, -32.843, 42.075}};

text2 = Graphics3D[{Blue, 
Map[Style[Text[Sequence @@ #], Bold] &, 
 Transpose[{{"Sun", "Sirius", "Canopus", "Arcturus", "Rigil K", 
    "Vega", "Rigel", "Procyon", "Betelgeuse", "Bellatrix", 
    "Capella", "Aldebaran", "Antares", "Pollux", "Castor", 
    "Regulus", "VY Canis M", "Proxima C", "Barnard", "Wolf 359", 
    "Lalande 21185", "Ross 154", "Epsilon Eri", "Tau Ceti", 
    "Kruger 60", "Gliese 876", "55 Cancri", "61 Virginis", 
    "51 Pegasi", "Altair", "Achernar", "Fomalhaut", "Spica", 
    "Polaris", "Deneb", "Algol", "Mimosa", "BY Draconis"}, 
   data2}]]}];

Show[ListPointPlot3D[data2,PlotRange -> {{-4000, 4000}, {-4000, 4000}, {-4000, 4000}}, BoxRatios -> {1, 1, 1}, AxesLabel -> {X, Y, Z},   LabelStyle -> Directive[Blue, Bold], ImageSize -> {700},   PlotStyle -> Directive[Blue, PointSize[Large]]], text2]

Manipulate[ListPointPlot3D[data2, PlotRange -> {{-n, n}, {-n, n}, {-n, n}}, BoxRatios -> {1, 1, 1}, AxesLabel -> {X, Y, Z}, LabelStyle -> Directive[Blue, Bold], ImageSize -> {700},    PlotStyle -> Directive[Blue, PointSize[Large]]], {n, 1, 4000}];
Improve this question
$\endgroup$
  • $\begingroup$ Look up Text[] or Inset[]. $\endgroup$ – J. M.'s ennui♦ May 27 '16 at 20:55
  • $\begingroup$ What you have works if you take the Show and stick in in Manipulate replacing the PlotRange with PlotRange -> {{-n, n}, {-n, n}, {-n, n}}. However, the plot jumps around in size (frankly, I don't understand why). $\endgroup$ – Jack LaVigne May 27 '16 at 21:35
3
$\begingroup$

Perhaps this solution, which uses Tooltip, will work for you. I prefer this approach because it is simple and minimizes clutter in the plot.

data = 
  {{0.000, 0.000, 0.000}, {-1.612, 8.077, -2.474}, {-19.599, 186.849, -246.583}, 
   {-29.000, -19.499, 12.157}, {-1.646, -1.375, -3.842}, {3.127, -19.235, 15.660}, 
   {167.744, 834.512, -122.686}, {-5.353, 9.547, 1.096}, {13.369, 634.519, 82.506}, 
   {36.150, 235.772, 26.543}, {5.481, 28.657, 30.211}, {22.354, 58.173, 18.471}, 
   {-206.890, -495.847, -267.081}, {-13.242, 26.759, 16.267}, 
   {-17.712, 40.444, 27.470}, {-66.567, 35.256, 15.966}, 
   {-1224.806, 3234.005, -1669.329}, {-1.546, -1.183, -3.769}, 
   {-0.057, -5.943, 0.488}, {-7.430, 2.113, 0.950}, {-6.506, 1.642, 4.870}, 
   {1.910, -8.647, -3.912}, {6.213, 8.314, -1.729}, {10.287, 5.021, -3.269}, 
   {6.468, -2.746, 11.114}, {14.243, -4.268, -3.780}, {-24.260, 25.880, 19.125}, 
   {-24.952, -8.886, -8.766}, {45.832, -12.825, 18.049}, {7.807, -14.872, 2.621}, 
   {68.981, 31.332, -117.728}, {20.933, -5.840, -12.357}, 
   {-237.661, -92.652, -50.329}, {4.354, 3.396, 429.965}, 
   {1184.687, -1394.076, 1847.449}, {47.862, 51.402, 60.959}, 
   {-172.829, -36.515, -302.153}, {4.898, -32.843, 42.075}};

names = 
  {"Sun", "Sirius", "Canopus", "Arcturus", "Rigil K", "Vega", 
   "Rigel", "Procyon", "Betelgeuse", "Bellatrix", "Capella", 
   "Aldebaran", "Antares", "Pollux", "Castor", "Regulus", 
   "VY Canis M", "Proxima C", "Barnard", "Wolf 359", "Lalande 21185", 
   "Ross 154", "Epsilon Eri", "Tau Ceti", "Kruger 60", "Gliese 876", 
   "55 Cancri", "61 Virginis", "51 Pegasi", "Altair", "Achernar", 
   "Fomalhaut", "Spica", "Polaris", "Deneb", "Algol", "Mimosa", 
   "BY Draconis"};

Manipulate[
  Graphics3D[
    {Blue, PointSize[Large], MapThread[Tooltip[Point@#1, #2] &, {data2, names}]}, 
    PlotRange -> {{-n, n}, {-n, n}, {-n, n}},
    BoxRatios -> {1, 1, 1},
    Axes -> True,
    AxesLabel -> {X, Y, Z},
    LabelStyle -> Directive[Blue, Bold]],
  {n, 50, 3500, 50, Appearance -> "Labeled"}]

stars

Improve this answer
$\endgroup$
  • $\begingroup$ Hi, Thanks for replying! I think i will go along your method. However i need to add a circle in the 3d box which has four points in degrees: 0, 90, 180 and 270? Can you help please? Thanks $\endgroup$ – Vick Jun 13 '16 at 14:50
  • $\begingroup$ @VickramRatnam. You should ask about your circle in a new question. When you do, please make it clear how you want the 2D circle to be placed in a 3D plot -- it is not a trivial matter. $\endgroup$ – m_goldberg Jun 14 '16 at 0:10
2
$\begingroup$ 
labels = {"Sun", "Sirius", "Canopus", "Arcturus", "Rigil K", "Vega", 
   "Rigel", "Procyon", "Betelgeuse", "Bellatrix", "Capella", 
   "Aldebaran", "Antares", "Pollux", "Castor", "Regulus", 
   "VY Canis M", "Proxima C", "Barnard", "Wolf 359", "Lalande 21185", 
   "Ross 154", "Epsilon Eri", "Tau Ceti", "Kruger 60", "Gliese 876", 
   "55 Cancri", "61 Virginis", "51 Pegasi", "Altair", "Achernar", 
   "Fomalhaut", "Spica", "Polaris", "Deneb", "Algol", "Mimosa", "BY Draconis"};

Using BubbleChart3D and its ChartLabels option:

Manipulate[BubbleChart3D[Pick[{##, 1} & @@@ data2, 
                              And[-n <= # <= n, -n <= #2 <= n, -n <= #3 <= n]& @@@ data2], 
  ChartStyle -> 1, ChartLabels ->labels, 
  LabelingFunction -> (Placed[#3[[2, 1]], Tooltip] &), 
  PlotRange -> {{-n, n}, {-n, n}, {-n, n}}], {n, 1, 4000}]

Mathematica graphics

Use ChartLabels -> Placed[labels, None] to get: Mathematica graphics

Improve this answer
$\endgroup$

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.