7
$\begingroup$

How can I stop the label from moving up and down, when rotating using the mouse?

Manipulate[

 v = {vx, vy, vz};
 start = {sx, sy, sz};

 Show[

  Graphics3D[{Black,
    Table[{Dashing[0.005], Line[{{i, -5, 0}, {i, 5, 0}}], 
      Line[{{-5, i, 0}, {5, i, 0}}], 
      Line[{{-.2, 0, i}, {.2, 0, i}}]}, {i, -5, 5}], Thick, 
    Arrow[{{0, 0, -5}, {0, 0, 5.5}}], 
    Style[Arrow[{{0, -5, 0}, {0, 5.5, 0}}], Antialiasing -> True],
    Arrow[{{-5, 0, 0}, {5.5, 0, 0}}],
    Text[Style["x", 16, Italic], {5.8, 0, 0}], 
    Text[Style["y", 16, Italic], {0, 5.8, 0}], 
    Text[Style["z", 16, Italic], {0, 0, 5.8}],

    Red,
    Arrow[Tube[{start, start + v}]],
    Purple,
    If[stedvektor,
     Arrow[{o, v}]],

    If[koord && stedvektor, {
      PointSize -> 0.008, Point[{vx, vy, 0}], Dashing[{.005, .005}], 
      Line[{{vx, vy, 0}, v, {0, 0, vz}}], 
      Line[{{0, vy, 0}, {vx, vy, 0}, {vx, 0, 0}}],
      (*Text[Style[vx,16],{vx,0,.5}],Text[Style[vy,16],{0,vy,.5}],
      Text[Style[vz,16],{.5,.5,vz}],*)
      Text[Style[Row[{"(", nf[vx], ", ", nf[vy], ", ", nf[vz], " )"}],
         12], {vx + 1, vy + 1, vz + .3}]}]



    }], PlotRange -> {{-5.5, 5.5}, {-5.5, 5.5}, {-5.5, 5.5}}, 
  AxesLabel -> {Style["x", Italic], Style["y", Italic], 
    Style["z", Italic]}, Boxed -> False, ImageSize -> {290, 300},
  Axes -> False, Boxed -> False,

  PlotLabel -> If[koord, Text[Style[Row[{vec["a"], " = ", ( {
          {nf[vx]},
          {nf[vy]},
          {nf[vz]}
         } )}], Red, 14]],
    Text[Style[Row[{vec["a"], " = ", ( {
          {Subscript[a, 1]},
          {Subscript[a, 2]},
          {Subscript[a, 3]}
         } )}], Red, 14]]
    ],


  ViewPoint -> 
   1200 {Cos[-p[[1]]] Sin[p[[2]]], Sin[-p[[1]]] Sin[p[[2]]], 
     Cos[p[[2]]]},

  ViewAngle -> 0.0009,

  SphericalRegion -> True],


 Row[{
   Control[{{dimension, 2, "Antal dimensioner"}, {1, 2, 3}}], 
   Control[{{koord, True, "Vis koordinater"}, {True, False}}],
   Control[{{stedvektor, False, "Vis stedvektor"}, {True, False}}]}, 
  Spacer[20]],


 Style[Row[{"Vektor ", vec[a]}], 12, Bold],

 {{vx, 3, Subscript[a, 1]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{vy, 1, Subscript[a, 2]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{vz, 3, Subscript[a, 3]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},

 Delimiter,


 Style["Startpunkt", 12, Bold],

 {{sx, 2, Subscript[x, 0]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{sy, -2, Subscript[y, 0]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{sz, 1, Subscript[z, 0]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{start, {2, -2, 1}}, ControlType -> None},
 {{o, {0, 0, 0}}, ControlType -> None},



 Initialization :> (

   p := {2 Pi - Pi/4, Pi/3};
   vec[a_] := Style[OverVector[a], Bold];
   nf[n_] := NumberForm[n, {2, 1}];
   halfway[v_] := 
    0.5 Norm[v] {Cos[(ArcTan @@ v - 1.5 ArcTan[Norm[v], .4])], 
      Sin[(ArcTan @@ v - 1.5 ArcTan[Norm[v], .4])]}; 
   halfway2[v_] := 
    0.5 Norm[v] {Cos[(ArcTan @@ v - 2.5 ArcTan[Norm[v], .4])], 
      Sin[(ArcTan @@ v - 2.5 ArcTan[Norm[v], .4])]}),

 TrackedSymbols :> {start, slut, koord, stedvektor, dimension, vx, vy,
    vz, sx, sy, sz, p}
 ]
Improve this question
$\endgroup$
1
  • 1
    $\begingroup$ FWIW You can use {} as the third argument of If to eliminate the pink error notice, e.g. If[stedvektor, Arrow[{o, v}], {}]. That doesn't fix the jumping label however. $\endgroup$
    – Mr.Wizard
    Jul 29, 2013 at 10:42

4 Answers 4

Reset to default
8
$\begingroup$

You could use the Labeled function instead of the option PlotLabel. I also used MatrixForm for the representation of the vector a:

Manipulate[v = {vx, vy, vz}; start = {sx, sy, sz}; 
     Labeled[Show[
       Graphics3D[{Black, 
         Table[{Dashing[0.005], Line[{{i, -5, 0}, {i, 5, 0}}], 
           Line[{{-5, i, 0}, {5, i, 0}}], 
           Line[{{-.2, 0, i}, {.2, 0, i}}]}, {i, -5, 5}], Thick, 
         Arrow[{{0, 0, -5}, {0, 0, 5.5}}], 
         Style[Arrow[{{0, -5, 0}, {0, 5.5, 0}}], Antialiasing -> True], 
         Arrow[{{-5, 0, 0}, {5.5, 0, 0}}], 
         Text[Style["x", 16, Italic], {5.8, 0, 0}], 
         Text[Style["y", 16, Italic], {0, 5.8, 0}], 
         Text[Style["z", 16, Italic], {0, 0, 5.8}], Red, 
         Arrow[Tube[{start, start + v}]], Purple, 
         If[stedvektor, Arrow[{o, v}]], 
         If[koord && stedvektor, {PointSize -> 0.008, Point[{vx, vy, 0}], 
           Dashing[{.005, .005}], Line[{{vx, vy, 0}, v, {0, 0, vz}}], 
           Line[{{0, vy, 0}, {vx, vy, 0}, {vx, 0, 0}}],(*Text[Style[vx,
           16],{vx,0,.5}],Text[Style[vy,16],{0,vy,.5}],Text[Style[vz,
           16],{.5,.5,vz}],*)
           Text[Style[
             Row[{"(", nf[vx], ", ", nf[vy], ", ", nf[vz], " )"}], 
             12], {vx + 1, vy + 1, vz + .3}]}]}], 
       PlotRange -> {{-5.5, 5.5}, {-5.5, 5.5}, {-5.5, 5.5}}, 
       AxesLabel -> {Style["x", Italic], Style["y", Italic], 
         Style["z", Italic]}, Boxed -> False, ImageSize -> {290, 300}, 
       Axes -> False, Boxed -> False, 
       ViewPoint -> 
        1200 {Cos[-p[[1]]] Sin[p[[2]]], Sin[-p[[1]]] Sin[p[[2]]], 
          Cos[p[[2]]]}, ViewAngle -> 0.0009, SphericalRegion -> True], 
      If[koord, 
       Text[Style[
         Row[{vec["a"], 
           " = ", (MatrixForm@{{nf[vx]}, {nf[vy]}, {nf[vz]}})}], Red, 
         14]], Text[
        Style[Row[{vec["a"], 
           " = ", (MatrixForm@{{Subscript[a, 1]}, {Subscript[a, 
                2]}, {Subscript[a, 3]}})}], Red, 14]]], Top], 
     Row[{Control[{{dimension, 2, "Antal dimensioner"}, {1, 2, 3}}], 
       Control[{{koord, True, "Vis koordinater"}, {True, False}}], 
       Control[{{stedvektor, False, "Vis stedvektor"}, {True, False}}]}, 
      Spacer[20]], 
     Style[Row[{"Vektor ", vec[a]}], 12, 
      Bold], {{vx, 3, Subscript[a, 1]}, -5, 5, ControlType -> Slider, 
      ImageSize -> Tiny, 
      ControlPlacement -> Left}, {{vy, 1, Subscript[a, 2]}, -5, 5, 
      ControlType -> Slider, ImageSize -> Tiny, 
      ControlPlacement -> Left}, {{vz, 3, Subscript[a, 3]}, -5, 5, 
      ControlType -> Slider, ImageSize -> Tiny, 
      ControlPlacement -> Left}, Delimiter, 
     Style["Startpunkt", 12, Bold], {{sx, 2, Subscript[x, 0]}, -5, 5, 
      ControlType -> Slider, ImageSize -> Tiny, 
      ControlPlacement -> Left}, {{sy, -2, Subscript[y, 0]}, -5, 5, 
      ControlType -> Slider, ImageSize -> Tiny, 
      ControlPlacement -> Left}, {{sz, 1, Subscript[z, 0]}, -5, 5, 
      ControlType -> Slider, ImageSize -> Tiny, 
      ControlPlacement -> Left}, {{start, {2, -2, 1}}, 
      ControlType -> None}, {{o, {0, 0, 0}}, ControlType -> None}, 
     Initialization :> (p := {2 Pi - Pi/4, Pi/3}; 
       vec[a_] := Style[OverVector[a], Bold]; 
       nf[n_] := NumberForm[n, {2, 1}]; 
       halfway[v_] := 
        0.5 Norm[v] {Cos[(ArcTan @@ v - 1.5 ArcTan[Norm[v], .4])], 
          Sin[(ArcTan @@ v - 1.5 ArcTan[Norm[v], .4])]}; 
       halfway2[v_] := 
        0.5 Norm[v] {Cos[(ArcTan @@ v - 2.5 ArcTan[Norm[v], .4])], 
          Sin[(ArcTan @@ v - 2.5 ArcTan[Norm[v], .4])]}), 
     TrackedSymbols :> {start, slut, koord, stedvektor, dimension, vx, vy,
        vz, sx, sy, sz, p}]

enter image description here

By using Labeled, the label won't change upon rotation of the Graphics3D object.

Improve this answer
$\endgroup$
6
$\begingroup$

Another option, is use Grid. I prefer Grid, since you get good control of positions and spacings between components that fill up the Grid.

I avoid using PlotLabel with 3D graphics due to known issues with that. So, I changed your code to have this layout

 Grid[{{ label, Graphic3D[....,viewPoint...] }}]

I removed Show and moved the ViewPoint into Graphics3D

Here is the result

Mathematica graphics

Manipulate[

 v = {vx, vy, vz};
 start = {sx, sy, sz};


Grid[{{
   If[koord, Style[Row[{vec["a"], " = ", ( MatrixForm@{
          {nf[vx]},
          {nf[vy]},
          {nf[vz]}
         } )}], Red, 14],
    Style[Row[{vec["a"], " = ", ( MatrixForm@{
          {Subscript[a, 1]},
          {Subscript[a, 2]},
          {Subscript[a, 3]}
         } )}], Red, 14]
    ]
  },
  {
  Graphics3D[{Black,
    Table[{Dashing[0.005], Line[{{i, -5, 0}, {i, 5, 0}}], 
      Line[{{-5, i, 0}, {5, i, 0}}], 
      Line[{{-.2, 0, i}, {.2, 0, i}}]}, {i, -5, 5}], Thick, 
    Arrow[{{0, 0, -5}, {0, 0, 5.5}}], 
    Style[Arrow[{{0, -5, 0}, {0, 5.5, 0}}], Antialiasing -> True],
    Arrow[{{-5, 0, 0}, {5.5, 0, 0}}],
    Text[Style["x", 16, Italic], {5.8, 0, 0}], 
    Text[Style["y", 16, Italic], {0, 5.8, 0}], 
    Text[Style["z", 16, Italic], {0, 0, 5.8}],

    Red,
    Arrow[Tube[{start, start + v}]],
    Purple,
    If[stedvektor,
     Arrow[{o, v}]],

    If[koord && stedvektor, {
      PointSize -> 0.008, Point[{vx, vy, 0}], Dashing[{.005, .005}], 
      Line[{{vx, vy, 0}, v, {0, 0, vz}}], 
      Line[{{0, vy, 0}, {vx, vy, 0}, {vx, 0, 0}}],
      (*Text[Style[vx,16],{vx,0,.5}],Text[Style[vy,16],{0,vy,.5}],
      Text[Style[vz,16],{.5,.5,vz}],*)
      Text[Style[Row[{"(", nf[vx], ", ", nf[vy], ", ", nf[vz], " )"}],
         12], {vx + 1, vy + 1, vz + .3}]}]



    }, PlotRange -> {{-5.5, 5.5}, {-5.5, 5.5}, {-5.5, 5.5}}, 
  AxesLabel -> {Style["x", Italic], Style["y", Italic], 
    Style["z", Italic]}, Boxed -> False, ImageSize -> {290, 300},
  Axes -> False, Boxed -> False,



  ViewPoint -> 
   1200 {Cos[-p[[1]]] Sin[p[[2]]], Sin[-p[[1]]] Sin[p[[2]]], 
     Cos[p[[2]]]},

  ViewAngle -> 0.0009,

  SphericalRegion -> True]
  }},Frame->All],


 Row[{
   Control[{{dimension, 2, "Antal dimensioner"}, {1, 2, 3}}], 
   Control[{{koord, True, "Vis koordinater"}, {True, False}}],
   Control[{{stedvektor, False, "Vis stedvektor"}, {True, False}}]}, 
  Spacer[20]],


 Style[Row[{"Vektor ", vec[a]}], 12, Bold],

 {{vx, 3, Subscript[a, 1]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{vy, 1, Subscript[a, 2]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{vz, 3, Subscript[a, 3]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},

 Delimiter,


 Style["Startpunkt", 12, Bold],

 {{sx, 2, Subscript[x, 0]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{sy, -2, Subscript[y, 0]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{sz, 1, Subscript[z, 0]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, ControlPlacement -> Left},
 {{start, {2, -2, 1}}, ControlType -> None},
 {{o, {0, 0, 0}}, ControlType -> None},



 Initialization :> (

   p := {2 Pi - Pi/4, Pi/3};
   vec[a_] := Style[OverVector[a], Bold];
   nf[n_] := NumberForm[n, {2, 1}];
   halfway[v_] := 
    0.5 Norm[v] {Cos[(ArcTan @@ v - 1.5 ArcTan[Norm[v], .4])], 
      Sin[(ArcTan @@ v - 1.5 ArcTan[Norm[v], .4])]}; 
   halfway2[v_] := 
    0.5 Norm[v] {Cos[(ArcTan @@ v - 2.5 ArcTan[Norm[v], .4])], 
      Sin[(ArcTan @@ v - 2.5 ArcTan[Norm[v], .4])]}),

 TrackedSymbols :> {start, slut, koord, stedvektor, dimension, vx, vy,
    vz, sx, sy, sz, p}
 ]
Improve this answer
$\endgroup$
6
$\begingroup$

I will explain what's going on -- well, some of it anyway. I don't understand why Mathematica has to make the label jump around in certain circumstances. The problem seems to arise when height of ImageSize is not set to Automatic (e.g. {290, Automatic}) in the output Cell. This can happen automatically when the graphics are moved with the mouse. Whenever view properties other than ViewPoint and ViewVertical (ViewAngle, ViewCenter and so forth) are not set to the automatic defaults, either programmatically or by the user modifying the graphics with the mouse, the front end automatically resets the ImageSize option in the output to a pair of specific numbers. It may be worth noting that in these circumstances, the front end seems to corral the label into the bounding box of the graphics image whenever the mouse is dragged. But that seems unnecessary since it doesn't happen always.

Others have already posted workarounds that avoid using PlotLabel. Here are some that let you use it. Your code is so long and mine adds to it, I substituted some random graphics for the purposes of illustration. I hope you can follow what changes are to be made to your code.

First solution

The source of the problem in your code is ViewAngle -> 0.0009. If you remove this and go with the default ViewAngle, the label doesn't jump (unless the user zooms or pans with the mouse). I would also point out that having a ViewPoint that is so far away makes zooming with the mouse virtually impossible to control. If you replace 1200 by, say, 12, the perspective is still minimal, but manipulation with the mouse is much easier. (The third solution below displays the graphics with an orthographic projection, so no perspective at all.)

Second solution

Another way to keep the label from jumping is to use another graphic to control the rotation by keeping their view properties synchronized ref.

We wrap the view properties in Dynamic and add another graphics with a cuboid as a "control." If Deploy is uncommented, then the graphics in the Manipulate display cannot be moved with the mouse; only the control graphics can be used.

Manipulate[
 SeedRandom[1];
 (*Deploy@*) (* Deploy to keep the main graphic from responding to mouse *)
 Graphics3D[{Line[Accumulate /@ RandomReal[{-1, 1} , {n, 10, 3}]]}, 
  PlotLabel -> 
   Row[{vec["a"], " = ", ({{nf[vx]}, {nf[vy]}, {nf[vz]}})}, 
    BaseStyle -> {Red, 14}],
  PlotRange -> 5, Axes -> False, ImageSize -> 290, 
  SphericalRegion -> True,
  (* add these options *)
  ViewVector -> Dynamic[vVector], ViewAngle -> Dynamic[vAngle],
  ViewVertical -> Dynamic[vVertical]
  (**)
  ],
 {{n, 10}, 1, 20, 1, ImageSize -> Tiny},
 (* add the following *)
 {plot, ControlType -> None},
 {{vVector, {With[{p = N@{2 Pi - Pi/4, Pi/3}}, 
     Scaled[12 {Cos[-p[[1]]] Sin[p[[2]]], Sin[-p[[1]]] Sin[p[[2]]], 
        Cos[p[[2]]]}]], {0., 0., 0.}}}, ControlType -> None},
 {{vVertical, {0, 0, 1}}, ControlType -> None},
 {{vAngle, 0.12}, ControlType -> None},
 Dynamic@Framed[
   Graphics3D[{Cuboid[{0, 0, 0}, {5, 5, 5}]}, PlotRange -> 5, 
    ImageSize -> 90, SphericalRegion -> True, 
    ViewVector -> Dynamic[vVector], ViewAngle -> Dynamic[vAngle], 
    ViewVertical -> Dynamic[vVertical]], FrameMargins -> 0, 
   FrameStyle -> LightGray],
 (**)
 ControlPlacement -> Left
 ]

Mathematica graphics

Third solution

This is an adaptation of my answer here: How to get rid of the perspective effect in a 3D graphics

In that answer we use Inset to put your graphics inside another graphics. The two graphics have their view properties connected via Dynamic as in the previous solution. When the mouse is used, it modifies the outer graphics and the inner one with the label is kept synchronized dynamically. The main difference, which is small, is that I needed to add some ImagePadding to get all the label to show. No doubt how much depends on the size of the label.

The first set of auxiliary functions was adapted from Heike's answer, Extract values for ViewMatrix from a Graphics3D

(*Heike*)
theta[v1_] := ArcTan[v1[[3]], Norm[v1[[;; 2]]]];
phi[v1_] := 
  If[Norm[v1[[;; 2]]] > .0001, ArcTan[v1[[1]], v1[[2]]], 0];
alpha[vert_, v1_] := 
  ArcTan[{-Sin[phi[v1]], Cos[phi[v1]], 0}.vert, 
   Cross[v1/Norm[v1], {-Sin[phi[v1]], Cos[phi[v1]], 0}].vert];
tt[v1_, vert_, center_, r_, scale_] := 
  TransformationMatrix[
   RotationTransform[-alpha[vert/scale, v1], {0, 0, 
      1}].RotationTransform[-theta[v1], {0, 1, 
      0}].RotationTransform[-phi[v1], {0, 0, 1}].ScalingTransform[
     r {1, 1, 1}].TranslationTransform[-center]];

(*orthographic projection*)
pp = N@{{1, 0, 0, 1}, {0, 1, 0, 1}, {0, 0, -1, 0}, {0, 0, 0, 2}};


With[{pRange = {{-5.5, 5.5}, {-5.5, 5.5}, {-5.5, 5.5}}, 
  viewPoint0 = 
   With[{p = N@{2 Pi - Pi/4, Pi/3}}, 
    12 {Cos[-p[[1]]] Sin[p[[2]]], Sin[-p[[1]]] Sin[p[[2]]], 
      Cos[p[[2]]]}]},
 
 Manipulate[
  plot = Graphics3D[{Line[Accumulate /@ RandomReal[{-1, 1} , {n, 10, 3}]]}, 
    PlotLabel -> Row[{vec["a"], " = ", ({{nf[vx]}, {nf[vy]}, {nf[vz]}})}, 
      BaseStyle -> {Red, 14}],
    PlotRange -> pRange, Axes -> False, ImageSize -> 290, 
    SphericalRegion -> True
    ];
  
  (* add this *)
  Graphics3D[{}, 
   Epilog -> Inset[
     Show[plot,
          ViewMatrix ->
            Dynamic @ {tt[vPoint, vVertical, vCenter, Cot[vAngle/2]/Norm[vPoint], scale],
                       pp}],
     Center, Center, 1], 
   ViewAngle -> Dynamic[vAngle], 
   ViewVector -> 
    Dynamic[vVector, (vVector = #; vCenter = vVector[[2]]; 
                      vPoint = vVector[[1]] - vCenter) &], 
   ViewVertical -> Dynamic[vVertical], SphericalRegion -> True, 
   PlotRange -> pRange, Boxed -> False, 
   ImagePadding -> {{0, 0}, {0, 80}}],
  (**)
  
  {{n, 10}, 1, 20, 1},
  
  (* add the following *)
  {plot, ControlType -> None},
  {{vPoint, viewPoint0}, ControlType -> None},
  {{vCenter, {0., 0., 0.}}, ControlType -> None},
  {{vVector, {viewPoint0, {0., 0., 0.}}}, ControlType -> None},
  {{vVertical, {0, 0, 1}}, ControlType -> None},
  {{vAngle, 2 ArcCot[2.]}, ControlType -> None},
  {{scale, 1/Abs[#1 - #2] & @@@ pRange}, ControlType -> None},
  (**)
  
  TrackedSymbols :> {n}
  ]
 ]

Mathematica graphics

Improve this answer
$\endgroup$
3
$\begingroup$

Another possible fix for the jumping PlotLabel is to wrap the entire output of Show, except for the PlotLabel, in 

Graphics[
  Inset[
     ...,
   ContentSelectable -> True
  ],
  ContentSelectable -> True
  ,
  PlotLabel -> ...
]

So the PlotLabel now is an option of Graphics into which the Graphics3D has been embedded as an Inset. That makes sure that the labels will never move. No other changes are required in your code. The 3D inset can only be manipulated with the mouse if we allow it to be selectable in the first place. That's what the ContentSelectable -> True options for both Graphics and Inset are for.

For completeness, here is the modified code (really I only inserted the above changes):

Manipulate[v = {vx, vy, vz};
 start = {sx, sy, sz};
 Graphics[
  Inset[
   Show[Graphics3D[{Black, 
      Table[{Dashing[0.005], Line[{{i, -5, 0}, {i, 5, 0}}], 
        Line[{{-5, i, 0}, {5, i, 0}}], 
        Line[{{-.2, 0, i}, {.2, 0, i}}]}, {i, -5, 5}], Thick, 
      Arrow[{{0, 0, -5}, {0, 0, 5.5}}], 
      Style[Arrow[{{0, -5, 0}, {0, 5.5, 0}}], Antialiasing -> True], 
      Arrow[{{-5, 0, 0}, {5.5, 0, 0}}], 
      Text[Style["x", 16, Italic], {5.8, 0, 0}], 
      Text[Style["y", 16, Italic], {0, 5.8, 0}],
      Text[Style["z", 16, Italic], {0, 0, 5.8}], Red, 
      Arrow[Tube[{start, start + v}]], Purple, 
      If[stedvektor, Arrow[{o, v}]], 
      If[koord && stedvektor, {PointSize -> 0.008, Point[{vx, vy, 0}],
         Dashing[{.005, .005}], Line[{{vx, vy, 0}, v, {0, 0, vz}}], 
        Line[{{0, vy, 0}, {vx, vy, 0}, {vx, 0, 0}}],(*Text[Style[vx,
        16],{vx,0,.5}],Text[Style[vy,16],{0,vy,.5}],Text[Style[vz,
        16],{.5,.5,vz}],*)
        Text[Style[
          Row[{"(", nf[vx], ", ", nf[vy], ", ", nf[vz], " )"}], 
          12], {vx + 1, vy + 1, vz + .3}]}]}], 
    PlotRange -> {{-5.5, 5.5}, {-5.5, 5.5}, {-5.5, 5.5}}, 
    AxesLabel -> {Style["x", Italic], Style["y", Italic], 
      Style["z", Italic]}, Boxed -> False, ImageSize -> {290, 300}, 
    Axes -> False, Boxed -> False,
    ViewPoint -> 
     1200 {Cos[-p[[1]]] Sin[p[[2]]], Sin[-p[[1]]] Sin[p[[2]]], 
       Cos[p[[2]]]}, ViewAngle -> 0.0009, SphericalRegion -> True],
   ContentSelectable -> True
   ],
  ContentSelectable -> True
  ,
  PlotLabel -> If[
    koord,
    Text[Style[
      Row[{vec["a"], " = ", ({{nf[vx]}, {nf[vy]}, {nf[vz]}})}], Red, 
      14]], Text[
     Style[Row[{vec["a"], 
        " = ", ({{Subscript[a, 1]}, {Subscript[a, 2]}, {Subscript[a, 
            3]}})}], Red, 14]],
    {}
    ]
  ],
 Row[{Control[{{dimension, 2, "Antal dimensioner"}, {1, 2, 3}}], 
   Control[{{koord, True, "Vis koordinater"}, {True, False}}], 
   Control[{{stedvektor, False, "Vis stedvektor"}, {True, False}}]}, 
  Spacer[20]], 
 Style[Row[{"Vektor ", vec[a]}], 12, 
  Bold], {{vx, 3, Subscript[a, 1]}, -5, 5, ControlType -> Slider, 
  ImageSize -> Tiny, 
  ControlPlacement -> Left}, {{vy, 1, Subscript[a, 2]}, -5, 5, 
  ControlType -> Slider, ImageSize -> Tiny, 
  ControlPlacement -> Left}, {{vz, 3, Subscript[a, 3]}, -5, 5, 
  ControlType -> Slider, ImageSize -> Tiny, 
  ControlPlacement -> Left}, Delimiter, 
 Style["Startpunkt", 12, Bold], {{sx, 2, Subscript[x, 0]}, -5, 5, 
  ControlType -> Slider, ImageSize -> Tiny, 
  ControlPlacement -> Left}, {{sy, -2, Subscript[y, 0]}, -5, 5, 
  ControlType -> Slider, ImageSize -> Tiny, 
  ControlPlacement -> Left}, {{sz, 1, Subscript[z, 0]}, -5, 5, 
  ControlType -> Slider, ImageSize -> Tiny, 
  ControlPlacement -> Left}, {{start, {2, -2, 1}}, 
  ControlType -> None}, {{o, {0, 0, 0}}, ControlType -> None}, 
 Initialization :> (p := {2 Pi - Pi/4, Pi/3};
   vec[a_] := Style[OverVector[a], Bold];
   nf[n_] := NumberForm[n, {2, 1}];
   halfway[v_] := 
    0.5 Norm[v] {Cos[(ArcTan @@ v - 1.5 ArcTan[Norm[v], .4])], 
      Sin[(ArcTan @@ v - 1.5 ArcTan[Norm[v], .4])]};
   halfway2[v_] := 
    0.5 Norm[v] {Cos[(ArcTan @@ v - 2.5 ArcTan[Norm[v], .4])], 
      Sin[(ArcTan @@ v - 2.5 ArcTan[Norm[v], .4])]}), 
 TrackedSymbols :> {start, slut, koord, stedvektor, dimension, vx, vy,
    vz, sx, sy, sz, p}]

manipulate

In practice I would use Nasser's answer, but this is one possible way in which PlotLabels can still be used without being so twitchy.

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks for this. This is nicer than my roundabout ways. In practice, actually, I put up with the twitchy labels. WRI ought to fix them. $\endgroup$
    – Michael E2
    Jul 30, 2013 at 0:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.