1
$\begingroup$

This question already has an answer here:

Suppose I have:

Graphics3D[{
  Arrow[{{-1, 0, 0}, {1, 0, 0}}],
  Arrow[{{0, -1, 0}, {0, 1, 0}}],
  Arrow[{{0, 0, -1}, {0, 0, 1}}],
  Red, PointSize[Large], Point[{.5, .5, 0}]
  }, ViewPoint -> {2, 1, 1}]

And:

Graphics3D[{
  Arrow[{{-1, 0, 0}, {1, 0, 0}}],
  Arrow[{{0, -1, 0}, {0, 1, 0}}],
  Arrow[{{0, 0, -1}, {0, 0, 1}}],
  {Opacity[0.75], InfinitePlane[{0, 0, 0}, {{0, 0, 1}, {1, 1, 0}}]},
  Red, PointSize[Large], Point[{.5, .5, .5}]
  }, ViewPoint -> {2, 1, 1}]

Now, what would be the best way to lay the two graphs side-by-side (one row, two columns), then draw an curved arrow starting at the point in the graph on the left (the first above) and ending at the point in the graph on the right (the second above).

Update Edit: I tried:

gr1 = Graphics3D[{
   Arrow[{{-10, 0, 0}, {10, 0, 0}}],
   Arrow[{{0, -10, 0}, {0, 10, 0}}],
   Arrow[{{0, 0, -10}, {0, 0, 10}}],
   Red, PointSize[Large], Point[{1, 0, 1}]
   }, ViewPoint -> {2, 1, 1}];
gr2 = Graphics3D[{
   {Opacity[0.6], InfinitePlane[{0, 0, 0}, {{1, 0, 3}, {0, 1, 1}}]},
   Arrow[{{-10, 0, 0}, {10, 0, 0}}],
   Arrow[{{0, -10, 0}, {0, 10, 0}}],
   Arrow[{{0, 0, -10}, {0, 0, 10}}],
   Red, PointSize[Large], Point[{1, 0, 3}]
   }, ViewPoint -> {2, 1, 1}];

Then I tried:

GraphicsRow[{gr1, gr2},
 Epilog -> {
   Line[{{0, 0}, {1, 1}}]
   }]

But only got this image:

enter image description here

How do we use the Epilog and Line command in this situation?

Second Update Edit: Looks like I've figure it out.

GraphicsRow[{gr1, gr2},
 Epilog -> {
   {Blue, Thick, Arrowheads[Medium], 
    Arrow[{{210, -152}, {580, -130}}]},
   Text[Style["T", 12, Blue, Bold, Background -> White], {395, -120}]
   }]

Which gives this image:

enter image description here

$\endgroup$

marked as duplicate by MarcoB, user9660, Öskå, Oleksandr R., dr.blochwave Jun 10 '16 at 9:34

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

  • 3
    $\begingroup$ GraphicsRow[] takes an Epilog option; you might have to do some eyeballing, tho. $\endgroup$ – J. M. will be back soon Jun 6 '16 at 20:11
  • $\begingroup$ The best I can think of is some messy combination or Row, Epilog, Arrow, and A LOT of hand tweaking... Perhaps it may be more expedient to export the graphics and do further layout in an external program. $\endgroup$ – MarcoB Jun 6 '16 at 20:19
  • 5
    $\begingroup$ related q/a: Adding dynamic graphics to an animation $\endgroup$ – kglr Jun 7 '16 at 0:24
  • $\begingroup$ @J.M. I gave your suggestion a try. Went to the documentation and looked at Graphics and searched the page for Epilog, but found no examples. Then I went to Epilog in the documentation and searched the page for Graphics, but found no examples. I've put my attempt in my original post. Can you show how to connect the two points with Epilog and Line. It would be much appreciated. $\endgroup$ – David Jun 10 '16 at 18:08
  • $\begingroup$ @J.M. I think I fixed your idea. I didn't realize where the origin was, where the positive and negative directions were, and the size. Thanks for you suggestion. $\endgroup$ – David Jun 10 '16 at 18:35
6
$\begingroup$

I hardly think that this is the best way and it may not even fit with your data because the view point will be fixed.

However, if you remove the box and axes you can draw the two pictures and manually insert the x, y and z box lines.

Then use Translate to shift the figure with the infinite plane an arbitrary distance (I used -1 for x, 3 for y and 0 for z).

Now draw a line between the original point and the shifted point.

Graphics3D[
 {
  (* First figure *)
  {
   Arrow[{{-1, 0, 0}, {1, 0, 0}}],
   Arrow[{{0, -1, 0}, {0, 1, 0}}],
   Arrow[{{0, 0, -1}, {0, 0, 1}}],
   Red,
   PointSize[Large],
   Point[{.5, .5, 0}],
   Black,
   Thin,
   Line[{{1, -1, -1}, {1, 1, -1}, {-1, 
      1, -1}, {-1, -1, -1}, {1, -1, -1}}],
   Line[{{1, -1, 1}, {1, 1, 1}, {-1, 1, 1}, {-1, -1, 1}, {1, -1, 1}}],
   Line[{{1, -1, -1}, {1, -1, 1}}],
   Line[{{1, 1, -1}, {1, 1, 1}}],
   Line[{{-1, -1, -1}, {-1, -1, 1}}],
   Line[{{-1, 1, -1}, {-1, 1, 1}}]
   },
  (* Second figure shifted *)
  Translate[{
    Arrow[{{-1, 0, 0}, {1, 0, 0}}],
    Arrow[{{0, -1, 0}, {0, 1, 0}}],
    Arrow[{{0, 0, -1}, {0, 0, 1}}],
    {
     Opacity[0.5],
     InfinitePlane[{0, 0, 0}, {{0, 0, 1}, {1, 1, 0}}]
     },
    Red,
    PointSize[Large],
    Point[{.5, .5, 0}],
    Black,
    Thin,
    Line[{{1, -1, -1}, {1, 1, -1}, {-1, 
       1, -1}, {-1, -1, -1}, {1, -1, -1}}],
    Line[{{1, -1, 1}, {1, 1, 1}, {-1, 1, 1}, {-1, -1, 1}, {1, -1, 1}}],
    Line[{{1, -1, -1}, {1, -1, 1}}],
    Line[{{1, 1, -1}, {1, 1, 1}}],
    Line[{{-1, -1, -1}, {-1, -1, 1}}],
    Line[{{-1, 1, -1}, {-1, 1, 1}}]
    },
   {-1, 3, 0}
   ],
  (* Arrow between points *)
  {
   Green,
   Arrow[{{0.5, 0.5, 0}, {-0.5, 3.5, 0}}]
   }
  },
 ViewPoint -> {2, 1, 1},
 Axes -> None,
 Boxed -> False
 ]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Nice. Exactly what I was looking for. Thanks. $\endgroup$ – David Jun 7 '16 at 2:27

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