Labeling points in 3D plot

There is something deeply unsatisfying in using Text in 3D graphics, and I think the poster agrees, having requested to "show only certain points". Let me illustrate the issue with an example.

Here is a dodecahedron

dodecahedron = With[{r5 = Sqrt[5]}, {
    "faceNormals" -> With[{a = (5 + r5)/10, b = (5 - r5)/10, g = 1/r5}, 
        With[{sa = Sqrt[a], sb = Sqrt[b]}, {
            {0, 0, 1}, {2 g, 0, g}, {b, sa, g}, {-a, sb, g}, {-a, -sb, g}, {b, -sa, g},{a, sb, -g}, {-b, sa, -g}, {-2 g, 0, -g}, {-b, -sa, -g}, {a, -sb, -g}, {0, 0, -1}
        }]],
    "vertices" -> With[{
        z = Sqrt[(25 - 11 r5)/2], f =  Sqrt[(5 - r5)/2], 
        x = (3 - r5)/2, r = (r5 - 1)/2, s = r5 - 2, 
        t = Sqrt[5 - 2 r5]}, {
            {-s, -t, 1}, {r, -z, 1}, {r, z, 1}, {-s, t, 1}, {-2 x, 0, 1}, 
            {2 r, 0, -s}, {1, t, s}, {1, -t, s}, {-x,f, s}, {x, f, -s},
            {-1, t, -s}, {-2 r, 0, s}, {-1, -t, -s}, {-x, -f, s}, {x, -f, -s},
            {2 x, 0, -1}, {s, t, -1}, {-r, z, -1}, {-r, -z, -1}, {s, -t, -1}
        }],
    "verticesAdj2Face" -> {
        {1, 2, 3, 4, 5}, {6, 7, 3, 2, 8}, {9, 4, 3,7, 10}, {4, 9, 11, 12, 5}, {12, 13, 14, 1, 5}, {2, 1, 14, 15, 8}, 
        {16, 17, 10, 7, 6}, {11, 9, 10, 17, 18}, {12, 11, 18, 19, 13}, {14, 13, 19, 20, 15}, {20, 16, 6, 8, 15}, {17, 16, 20, 19,18}
    },
    "verticesAdj2Edge" -> {
        {1, 5}, {1, 2}, {2, 3}, {3, 4}, {4, 5}, {6,8}, {6, 7}, {3, 7}, {2, 8}, {9, 10}, 
        {4, 9}, {7, 10}, {9, 11}, {11, 12}, {5, 12}, {12, 13}, {13, 14}, {1, 14}, {14, 15},
        {8, 15}, {6, 16}, {16, 17}, {10, 17}, {11, 18}, {17, 18}, {18, 19}, {13, 19}, {19, 20}, {15, 20}, {16, 20}
    },
    "facesAdj2Edge" -> {
        {1, 5}, {1, 6}, {1, 2}, {1, 3}, {1, 4}, {2, 11}, {2, 7}, {2, 3}, {2, 6}, {3, 8},
        {3, 4}, {3, 7}, {4, 8}, {4, 9}, {4, 5}, {5, 9}, {5, 10}, {5, 6}, {6, 10}, {6, 11},
        {7, 11}, {7, 12}, {7, 8}, {8, 9}, {8, 12}, {9, 12}, {9, 10}, {10, 12}, {10, 11}, {11, 12}}
    }
];

And here is look it looks like when the vertices are labeled the Text way, as outlined by eldo.

With[{vertices = "vertices" /. dodecahedron},
 Graphics3D[{
   Opacity[0.8],
   Map[Polygon[vertices[[#]]] &, "verticesAdj2Face" /. dodecahedron],
   Map[Text[Framed[#, Background -> White], vertices[[#]]] &, 
    Range[Length[vertices]]]
   }, Axes -> True]]

Here again, showing the faces fully opaque.

It's confusing, and it would only get worse, were you to label the faces and edges also; it is deeply unsatisfying that the labels which belong to the vertices "in the back" (of the current view point), such as vertex 18, which are "behind" shown faces, look all the same as the vertices "in front". Those vertices should be either completely invisible, or at least (when using Opaque[less than 1]) appear more faint, just the way the covered/hidden faces do.

Doing this with Text is completely impossible. Well, not unless you write some rather advanced custom code, different for each graphics, reacting to view point changes, which really doesn't seem a good option (I don't even know if Graphics3D has an "onViewPointChange" handler option.)

It is really a BIG SHAME that there isn't a built-in mathematica command, which takes a string, and projects it into a plane (with normal vector of the plane, rotation and position of the text to be additional parameters), so that Polygon of Graphics3D can just render it like all the rest of a graphics, so that the mentioned hiding or fainting of the "back" vertices would the occur automatically.

Something like this:

I did this very thing manually - not for arbitrary strings, only for strings composed out of the 10 digits.

Here is the number 7 as a Polygon.

seven2dPts = {{-0.328, 0.5}, {0.328, 0.5}, {0.08, -0.5}, {-0.088, -0.5}, {0.08, 0.316}, {-0.328, 0.316}, {-0.328, 0.5}};

The 7 rendered in 2D graphics.

Graphics[{Opacity[0.7], Polygon[seven2dPts]}, Axes -> True]

As you see it's centered (origin is center of framing box).

Let's project the 7 to the top, the front, and the right of a cube. Essentially, what we have to do is just multiply each of the points with a suitable orthonormal basis (ONB) of the plane in question, and add the mid point of that plane.

cube = {
    "faceNormals" -> {{0, 0, -1}, {0, 0, 1}, {1, 0, 0}, {0, 1, 0}, {-1,0, 0}, {0, -1, 0}},
    "vertices" -> {
        {1, 1, -1}, {1, -1, -1}, {-1, -1, -1}, {-1, 1, -1},
        {1, -1, 1}, {1, 1, 1}, {-1, 1, 1}, {-1, -1, 1}
    },
    "verticesAdj2Face" -> {
        {1, 2, 3, 4}, {5, 6, 7, 8}, {1, 6, 5, 2},
        {7, 6, 1, 4}, {7, 4, 3, 8}, {3, 2, 5, 8}
    }
};

With[{
    vertices = "vertices" /. cube,
    e1 = {1, 0, 0}, e2 = {0, 1, 0}, e3 = {0, 0, 1},
    addToEach = Function[{addMe, pointList}, 
        Transpose[addMe + Transpose[pointList]]
    ],
    onePlusEpsilon = 1.01
}, With[{
    onbTop = {e1, e2}, onbFront = {e1, e3}, onbRight = {e2, e3},
    centerTop = onePlusEpsilon e3,
    centerFront = -onePlusEpsilon e2,
    centerRight = onePlusEpsilon e1
},
Graphics3D[{
    Opacity[0.8], 
    Map[Polygon[vertices[[#]]] &, "verticesAdj2Face" /. cube],
    Black,
    Polygon[addToEach[centerTop, seven2dPts . onbTop]],
    Polygon[addToEach[centerFront, seven2dPts . onbFront]],
    Polygon[addToEach[centerRight, seven2dPts . onbRight]]
}, Axes -> True]]]

(If you'd replace onePlusEpsilon by 1, you'd see some strange effects, due to the "7" polygon intersecting with the plane polygons.)

(If you rotate the cube, you'll see the mirror-inverted image of the 7 from the other side.)

The choice of the ONB influences how the number is being rotated. Let's illustrate that by projecting the number 4 into the plane x=y, using different ONBs.

four2dPts = {{-55,75},{-55,-25},{8,-25},{8,-75},{32,-75},{32,-25},{55,-25},{55,-1},{32,-1},{32,75},{8,75},{8,-1},{-31,-1},{-31,75},{-55,75}}/150;
With[{
    g = Function[arg, Graphics3D[arg, Axes -> True]],
    normal = {1, -1, 0},
    r2 = Sqrt[2], r10 = Sqrt[10]
},
With[{
    onb1 = {{1, 1, -4}, {2, 2, 1}}/r10,
    onb2 = {{1, 1, 0}, {0, 0, -1}}/r2,
    onb3 = {{0, 0, 1}, {1, 1, 0}}/r2,
    onb4 = {{1, 1, 0}, {0, 0, 1}}/r2
},
GraphicsRow[
    g[Polygon[four2dPts  . #]] & /@ {onb1, onb2, onb3, onb4}
    , ImageSize -> 700]
]]

Usually, what you want is the first ONB vector (the "3D version of 2D-x") have a z component of zero, and the second ONB vector have a positive z component. That is possible, unless your normal vector is a multiple of {0,0,1}, and it's unique. This choice of ONB gives the "left to right" feeling. Unless you rotate the graphics, of course.

So I wrote 2 functions, numberPolygon, and numberProjector3D, which automate this process. numberPolygon, given a positive integer, produces a list of polygon point-lists (one for each digit), such that the resulting Polygons, as a whole, are centered around zero; second parameter is the desired height for each of the digits (which will always be the same). numberProjector3D takes a positive integer and the normal vector of the plane as parameters (and lot's of optional parameters), and calls numberPolygon.

numberPolygon[17, 10]

result:

{
    "data" -> {
        {{-4.84308,-5.},{-1.605,-5.},{-1.605,-3.70477},{-2.41452,-3.70477},{-2.41452,5.},{-4.03356,5.},{-5.955,2.10579},{-4.55287,1.29627},{-4.03356,2.19574},{-4.03356, -3.70477},{-4.84308, -3.70477},{-4.84308, -5.}},
        {{-0.605, 5.}, {5.955, 5.}, {3.475, -5.}, {1.795, -5.}, {3.475,3.16}, {-0.605, 3.16}, {-0.605, 5.}}
    },
    "width" -> 11.91, 
    "height" -> 10
}

So data is an array for the polygon points of the "1" and the "7".

Row[Framed[Graphics[{
    Opacity[0.7],
    Polygon[("data" /. numberPolygon[17, 10])[[#]]]
}, Axes -> True]] & /@ Range[2]]

Putting it on the cube as above:

With[{
    vertices = "vertices" /. cube,
    e1 = {1, 0, 0}, e2 = {0, 1, 0}, e3 = {0, 0, 1}
},
Graphics3D[{
    Opacity[0.8], 
    Map[Polygon[vertices[[#]]] &, "verticesAdj2Face" /. cube],
    numberProjector3D[17, #, 1] & /@ {e1, -e2, e3}
}, Axes -> True]
]

Here are the 10 digits

Row[Map[Function[n,
    Graphics[{
        Opacity[0.6],
        Polygon["data" /. numberPolygon[n, 10]]
    }, ImageSize -> 110, Axes -> True]
    ], {1, 2, 3, 4, 5, 6, 7, 8, 9, 0}
]]

Since it can't be avoided that you look at the numbers upside down from time to time, I took great care to make look the 6 and the 9 as different as possible. The 9 has 9 teeth.

If your normal vector is {nx, ny, nz}, then your plane equation is nx*x+ny*y+nz*z=rhs, for some "right hand side" rhs. The default value of rhs in numberProjector3D is 1, and you can change it with the "rhs" option. Due to this default value, we didn't need to do anything more in the "cube 17" example, because that's the rhs we need there.

If you don't normalize the normal vector, it has a similar effect as when you change rhs. Often, you'll want to use rhs = 0, and use the "translate" option to move the number around.

With[{g = Function[arg, Graphics3D[arg, Axes -> True]]},
    GraphicsRow[{
        g[Table[numberProjector3D[i, {0, 0, i + 1}, 2], {i, 0, 5}]],
        g[Table[numberProjector3D[i, {0, 0, 1}, 2, "rhs" -> i], {i, 0, 5}]],
        g[Table[numberProjector3D[i, {0, 0, 1}, 2, "rhs" -> 0, "translate" -> {0, 0, i + 1}], {i, 0, 5}]]
    }, ImageSize -> 800]
]

Example illustrating more options.

With[{co = Function[i, Cos[(3 - i) Pi/6]], si = Function[i, Sin[(3 - i) Pi/6]]},
    Graphics3D[Join[
        Table[numberProjector3D[i, {0, -1, 0}, 1, "rhs" -> 0, "translate" -> 3 {co[i], 1, si[i]}], {i, 12}],
        Table[numberProjector3D[i, {0, 0, 1}, 1, "rhs" -> 0, "translate" -> 3 {co[i],  si[i], -1}, "labelColor" -> Green], {i,12}],
        Table[numberProjector3D[i, {1, 0, 0}, 1, "rhs" -> 0, "translate" -> 3 {-1, co[i],  si[i]}, "backgroundColor" -> White, "labelColor" -> Black], {i, 12}]
    ], Axes -> True, ImageSize -> 700]
]

For 2-sided labels, use "showBackSide" option (not the same effect as removing the background, in which case what you see from the other side would be mirror-inverted.)

With[{co = Function[i, Cos[(3 - i) Pi/6]], si = Function[i, Sin[(3 - i) Pi/6]]},
    Graphics3D[Join[
    Table[numberProjector3D[i, {0, co[i], si[i]}, 1, "rhs" -> 0, "translate" -> 2 {0, -si[i], co[i]}, "scale"  -> 0.8], {i, 12}],
    Table[numberProjector3D[i, -{0, co[i], si[i]}, 1, "rhs" -> 0, "translate" -> 2 {1, -si[i], co[i]}, "scale"  -> 0.8], {i, 12}],
    Table[numberProjector3D[i, {0, co[i], si[i]}, 1, "rhs" -> 0, "translate" -> 2 {2, -si[i], co[i]}, "showBackSide" -> True], {i,12}],
    Table[numberProjector3D[i, {0, co[i], si[i]}, 1, "rhs" -> 0, "translate" -> 2 {3, -si[i], co[i]}, "showBackSide" -> True, "backsideScaleDownFactor" -> 1], {i, 12}]
]
, Axes -> True, ImageSize -> 900]]

[

Use "rotate" option to supply a 3x3 rotation matrix to rotate the label, or simply use "rotationAngle" option, if the rotation is within the plane (i.e., if the fixed line of the rotation is the normal vector.

With[{
    co = Function[i, Cos[(3 - i) Pi/6]],
    si = Function[i, Sin[(3 - i) Pi/6]],
    rotateByAngleWRTbase = Function[{base, angle}, With[{
        c = Cos@angle, s = Sin@angle, inv = Transpose@base
    }, 
        inv . {{1, 0, 0}, {0, c, s}, {0, -s, c}} . base
    ]],
    e1 = {1, 0, 0}, e2 = {0, 1, 0}, e3 = {0, 0, 1}
}, With[{
    base1 = {-e2, e1, e3}, base2 = {e3, e2, -e1},  base3 = {e1, e2, e3}},
    Graphics3D[Join[
    Table[numberProjector3D[i, {0, -1, 0}, 1, "rhs" -> 0, "translate" -> 3 {co[i], 1, si[i]}, "rotate" -> rotateByAngleWRTbase[base1, Pi/4]], {i, 12}],
    Table[numberProjector3D[i, {0, 0, 1}, 1, "rhs" -> 0, "translate" -> 3 {co[i],  si[i], -1}, "labelColor" -> Green, "rotate" -> rotateByAngleWRTbase[base2, Pi/4]], {i, 12}],
    Table[numberProjector3D[i, {1, 0, 0}, 1, "rhs" -> 0, "translate" -> 3 {-1, co[i],  si[i]}, "backgroundColor" -> White, "labelColor" -> Black, "rotate" -> rotateByAngleWRTbase[base3, Pi/4]], {i, 12}]
], Axes -> True, ImageSize -> 700]]]

Do the same thing simpler:

With[{
    co = Function[i, Cos[(3 - i) Pi/6]], 
    si = Function[i, Sin[(3 - i) Pi/6]]
}, Graphics3D[Join[
    Table[numberProjector3D[i, {0, -1, 0}, 1, "rhs" -> 0, "translate" -> 3 {co[i], 1, si[i]}, "rotationAngle" -> Pi/4], {i,12}],
    Table[numberProjector3D[i, {0, 0, 1}, 1, "rhs" -> 0, "translate" -> 3 {co[i],  si[i], -1}, "labelColor" -> Green, "rotationAngle" -> Pi/4], {i, 12}],
    Table[numberProjector3D[i, {1, 0, 0}, 1, "rhs" -> 0, "translate" -> 3 {-1, co[i],  si[i]}, "backgroundColor" -> White, "labelColor" -> Black, "rotationAngle" -> Pi/4], {i, 12}]
], Axes -> True, ImageSize -> 700]]

A rotation which cannot be done with the "rotationAngle" option:

With[{
    co = Function[i, Cos[(3 - i) Pi/6]], 
    si = Function[i, Sin[(3 - i) Pi/6]],
    rotateByAngleWRTbase = Function[{base, angle},
        With[{c = Cos@angle, s = Sin@angle, inv = Transpose@base},
            inv . {{1, 0, 0}, {0, c, s}, {0, -s, c}} . base
    ]],
    e1 = {1, 0, 0}, e2 = {0, 1, 0}, e3 = {0, 0, 1}
}, With[{base = {-e2, e1, e3}},
    Graphics3D[
        Table[numberProjector3D[i, {0, 0, 1}, 1, 
            "rhs" -> 0, 
            "translate" -> 3 {co[i],  si[i], -1},
            "labelColor" -> Green, 
            "rotate" -> rotateByAngleWRTbase[base, Pi/4]
        ], {i, 12}]
, Axes -> True, ImageSize -> 700]]]

There is a third function, called multiFaceNumberProjector3D, with which you can do things like project onto the mantle of a cylinger (if that cylinder is approximated by a suitable polyhedron. This post is getting long, so only one example for that.

showCylinderWithNumber[
    number_, halfDrumSize_, tileRange_, showBG_, showLabel_, bgColor_, labelColor_
] := With[{drumSize = 2*halfDrumSize}, With[{
    drumFaceNormals = N@Table[
    Append[With[{b = i \[Pi] /halfDrumSize}, {Cos[b], Sin[b]}], 0]
        , {i, 0, drumSize - 1}],
    drumVertices = N[With[{a = Cos[\[Pi]/drumSize]}, Join[
    Table[Append[With[{b = (2 i - 1) \[Pi]/drumSize}, {Cos[b], Sin[b]}]/a, -1]
        , {i, 0, drumSize - 1}],
    Table[Append[With[{b = (2 i - 1) \[Pi]/drumSize}, {Cos[b], Sin[b]}]/a,   1]
        , {i, 0, drumSize - 1}]
    ]]],
    drumVa2f = Append[
        Table[{1, 1 + drumSize, drumSize, 0} + i, {i, drumSize - 1}], 
        {1, 1 + drumSize, 2*drumSize, drumSize}
    ]
    }, With[{
        tileWidth = 
        With[{v1 = drumVertices[[1]], v2 = drumVertices[[2]]},
            With[{d = v1 - v2}, Sqrt[d . d]]]
    }, With[{
    cylindricLabel = Function[{tilesList, translate, roma, rhs},
    With[{labelSize = tileWidth},
        multiFaceNumberProjector3D[number, 
            drumFaceNormals[[tilesList]], labelSize,
            "omitBackground" -> True, "labelColor" -> labelColor, 
            "rhs" -> rhs,"scale" -> 1, "translate" -> translate, "rotate" -> roma, "offsetEpsilon" -> 0
        ]]]
    },
    Graphics3D[Join @@ {
        If[showBG, {bgColor, Map[Polygon[drumVertices[[#]]] &, drumVa2f]}, {}],
        If[showLabel, {labelColor, EdgeForm[None],cylindricLabel[tileRange, 0, IdentityMatrix[3], 1]
    }, {}]
    }]
]]]];

showCylinderWithNumber[1234567890, 300, Range[1, 590], False, True, Black, White]

The implementation of numberPolygon, numberProjector3D, and multiFaceNumberProjector3D is too long for this post, but I can put it on my website, if there are requests.

An alternative

data = 
   {{258, 1028, 0}, {217, 747, 0}, {212, 754, 0}, {210, 748, 0}, {191, 654, 0}, {157, 638, 0}};

Show[
 Graphics3D[{Blue, PointSize[0.04], Point[data]}],
 Graphics3D[Text[#[[1]], 1.04 #] & /@ data],
 Axes -> True,
 BoxRatios -> 1]

Just for fun with points more apart

data = 
{{258, 830, 0}, {217, 747, 0}, {212, 680, 0}, {210, 520, 0}, {191, 654, 0}, {157, 638, 0}};

Show[
 Graphics3D[Table[{RandomColor[], Sphere[n, 20]}, {n, data}]],
 Graphics3D /@ Map[Text[Framed[#[[1]], Background -> White], #] &, data],
 Axes -> True, ImageSize -> 500]

Few fixes to your code:

As is, your code specifies the position of labels as 2D coordinates. i.e., the the last 2 coordinates (#[[{2,3}]]) of data points. Since these labels will appear in a 3D graphics, instead of the the last 2 coordinates, you should take all three (#) to specify the position:

labels = Text[#[[1]], 1.04 #] & /@ TCzvdata

Then, (1) options should appear after the graphics objects in Show, (2) BoxRatios instead of AspectRatio for 3D graphics, and (3) as commented by belisarus, graphics objects inside Show should have the same dimension, So, your last line should be:

Show[dataPlot, Graphics3D[{Red, labels}], BoxRatios -> 1] 

Alternatively, you can use Inset:

Show[Graphics3D[{Red, Inset[Text[#[[1]]], {.98, .98, 1} #] & /@ TCzvdata}], dataPlot, 
 BoxRatios -> 1]

Or, post-process to add text labels to points:

dataPlot = ListPointPlot3D[TCzvdata, PlotStyle -> PointSize -> Large, BoxRatios->1] /. 
  Point[x : {__}, ___] :> {Point[x], Red, Text[#1, {.98, .98, 1} {##}] & @@@ x}