Labeling a ListPointPlot3D

Question

I've a problem with the label of ListPointPlot3D. I tried to reproduce a plot I've seen in a paper, but I was not able to reproduce it completely. Following and example of my data:

exampledata = {{0.492, 1.`, 0.0035}, {0.513`, 1., 0.002}, {0.533, 1., 
0.002}, {0.554, 1., 0.001}, {0.574, 1., 0.0009}, {0.5951, 1., 
0.0004796045722135073`}, {0.6157, 1., 0.00005}, {0.636, 
1., -0.0003}, {0.6567, 1., -0.00061}, {0.6574, 
1., -0.00062}, {0.492, 25., 0.00310}, {0.5130, 25., 
0.0023}, {0.533, 25., 0.0016}, {0.554, 25., 0.0010}, {0.5746, 25.,
 0.0005}, {0.5951, 25., 0.00004}, {0.6157, 25., -0.0003}, {0.6362,
 25., -0.00076}, {0.656, 25., -0.00108}, {0.6772, 25., -0.0013}};

this is my code for a 3D pointPlot

pic = Labeled[
ListPointPlot3D[exampledata, PlotTheme -> {Black}, ImageSize -> 500,
AxesStyle -> Gray, 
TicksStyle -> Directive["Label", Black, 14]], {Rotate[
Style["residuals", 15], 90  Degree], 
Rotate[Style["\!\(\*SubscriptBox[\(T\), \(r\)]\)", 15], 0 Degree], 
Rotate[Style["P (bar)", 15], 60 Degree], 
BaselinePosition -> Right}, {Left, Bottom, Right}]

and this is the result:

but I need a picture like this:

As you can see the right label isn't centered, I haven't got the lines inside my graph, and my graph is too short. Could you help me? Thanks.

Answer 1

With ListPointPlot3D[] the points can't be joined.
A better solution is to use the low level graphics primitives Line[] and Point[] directly :

    Graphics3D[
     {
     PointSize[0.03],
     Thickness[0.01],
     {Line[#], Point[#]} & /@ GatherBy[exampledata, #[[2]] &]
     },
     BoxRatios -> {1, 1, 1},
     FaceGrids -> {{-1, 0, 0}, {0, 1, 0}, {0, 0, -1}},
     Axes -> True,
     AxesLabel -> {Subscript["T", "r"], "P (bar)", "residuals"},
     AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}
     ]

The same figure with more Ticks :

{xRange, yRange, zRange} = {Min[#], Max[#]} & /@ Transpose[exampledata];
{xTicks, yTicks, zTicks} = N[FindDivisions[#, 5]] & /@ {xRange, yRange, zRange};

Graphics3D[
      {
      PointSize[0.03], 
      Thickness[0.01],
      {Line[#], Point[#]} & /@ GatherBy[exampledata, #[[2]] &]
      },
      BoxRatios -> {1, 1, 1},
      FaceGrids -> {
          {{-1, 0, 0}, {yTicks, zTicks}},
          {{0, 1, 0}, {xTicks, zTicks}},
          {{0, 0, -1}, {xTicks, yTicks}}},
      Ticks -> {xTicks, yTicks, zTicks},
      Axes -> True,
      AxesLabel -> {Subscript["T", "r"], "P (bar)", "residuals"},
      AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}
 ]