2
$\begingroup$

I am trying to add multiple texts to geometric objects (points in my example below). However, when I try a table inside the Graphics3D command it puts all texts at one point.

points = Flatten[Table[{i, j, k}, {i, 0, 1}, {j, 0, 1}, {k, 0, 1}], 2];
bonds = {{1, 2}, {2, 4}, {3, 4}, {1, 3}, {1, 5}, {2, 6}, {4, 8}, {3, 
    7}, {5, 6}, {6, 8}, {8, 7}, {7, 5}, {1, 6}, {2, 8}, {4, 7}, {3, 
    5}};

PlotSystem[points_, bonds_] := Module[{pts, edges},
  pts = Graphics3D[
    Table[{Point[points[[k]]], 
      Text[Style[ToString[k], Large, Bold, Red]]}, {k, 1, 
      Length[points]}], Boxed -> False];
  edges = Graphics3D[Line[
     ({points[[#[[1]]]], points[[#[[2]]]]}) & /@ bonds
     ], Boxed -> False];
  Show[pts, edges]
  ]
$\endgroup$

2 Answers 2

2
$\begingroup$
  • Or Graph with VertexLabels -> Automatic.
Graph[Range@Length@points, bonds, VertexCoordinates -> points, 
 VertexLabels -> Automatic, VertexLabelStyle -> Directive[Red, 20], 
 VertexSize -> .025, EdgeStyle -> Gray]

enter image description here

$\endgroup$
1
  • $\begingroup$ Very elegant way! $\endgroup$ Commented Oct 4 at 0:04
1
$\begingroup$

I will answer my own question. The Text command has an optional input to specify the location, which I didn't use in my codes (so all texts were put at the default location). I thought Mathematica automatically put the text to the graphic object in the same group but it is not the case.

The following codes now work perfectly

PlotSystem[points_, bonds_] := Module[{pts, edges},
  pts = Graphics3D[
    Table[{Point[points[[k]]], 
      Text[Style[ToString[k], Large, Bold, Red], points[[k]]]}, {k, 1,
       Length[points]}], Boxed -> False];
  edges = Graphics3D[Line[
     ({points[[#[[1]]]], points[[#[[2]]]]}) & /@ bonds
     ], Boxed -> False];
  Show[pts, edges]]
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.