Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have plotted a figure of MoS2 crytal structure. But the actual output looks like the spheres are not in the correct position due to the perspective effect.

I obtained the correct position figure by setting the ViewPoint to Infinity. But when I rotate the figure, the infinity effect fails and the perspective effect takes place again.

before and after rotation

I was wondering if there is a way to get rid of the perspective effect when you draw a graphic? Thank you.

Here is my code

a0 = 1; ceng = 1; znn =3*ceng; ynn = 5; xnn = 5; a1 = 2; cznn = 3; hh = 2;
p1[θ_] := RotationTransform[θ, {0, 0, 1}];
posx1 = (nx1 - 1) a0 + ((ny1 - 1) a0)/2 + (Mod[nz1 - 1, 3] a0)/2;
posy1 = Sqrt[3]/2 (ny1 - 1) a0 + (Sqrt[3] Mod[nz1 - 1, 3] a0)/6;
posz1 = Sqrt[3]/2 (nz1 - 1) a0 + Floor[(nz1 - 1)/3] a0;
sinpq2 = Transpose[Table[{posx1, posy1, posz1}, {ny1, ynn}, {nz1, znn}, {nx1, -xnn, 0}]];
rr = 0.3 a0;
tom2 = 
  Table[
    Graphics3D[{If[Mod[cc, 3] == 2, Pink, Yellow], Sphere[sinpq2[[cc, bb, aa]], rr]}], 
    {aa, xnn}, {bb, ynn}, {cc,znn}];
Show[tom2, 
  Axes -> False, 
  BoxStyle -> Directive[Orange, Opacity[0]],  
  BoxRatios -> Automatic, 
  PlotRange -> All, 
  Background -> Black,  
  ViewPoint -> {0, 0, ∞}]
share|improve this question
    
possible duplicate of Switching among view points in a Manipulate expression –  m_goldberg Jul 15 '13 at 10:08
1  
this might be a duplicate of 3D plots with parallel projection - not quite sure what's required –  cormullion Jul 15 '13 at 10:13
    
Try ViewPoint -> {0, 0, Dynamic[∞, None]} –  m_goldberg Jul 15 '13 at 10:25
    
@cormullion closely related because OP here want to rotate an object. –  Kuba Jul 15 '13 at 10:39
    
@kuba Ah yes, I see - as soon as you start to rotate the viewpoint changes back to perspective. m_goldberg's solution doesn't work for me either... –  cormullion Jul 15 '13 at 10:42

3 Answers 3

Maybe this will help a little (adapting documentation exaple for Slider2D):

 DynamicModule[{p = {2 π, 0}},
   Row @ {Slider2D[Dynamic[p], {{2 Pi, 0}, {0, Pi}}],
          Plot3D[Exp[-(x^2 + y^2)], {x, -3, 3}, {y, -3, 3}, 
            ImageSize -> {700, 700}, PlotRange -> All, ViewAngle -> .0015,
            ViewPoint -> Dynamic[1200 {Cos[p[[1]]] Sin[p[[2]]], 
                                       Sin[p[[1]]] Sin[p[[2]]], 
                                       Cos[p[[2]]]}
                         ]
          ]   
   }]

enter image description here

Notice that for parallel projection (like here) box edges do not seem to be parallel but they are and for default Mathematica display they are not but they look parallel

share|improve this answer
    
+1 Cool! Very smooth control of object. Far better than the Mathematica default, in my view. –  David Carraher Jul 15 '13 at 11:13
    
@DavidCarraher I'm glad You find it cool. What do You mean by "+1"? ;) –  Kuba Jul 15 '13 at 11:23
    
It means I upvoted your entry. –  David Carraher Jul 15 '13 at 12:37
    
@DavidCarraher I thought so but something strange is happening to my rep and inbox lately. Good luck with Your project. –  Kuba Jul 15 '13 at 12:39
    
Thanks a lot, Really cool –  MYG Jul 15 '13 at 14:56

I think the only way to do this is by dynamically reseting the ViewMatrix to be an orthographic projection. It was beyond my ability, patience, or inclination to figure how to decompose the ViewMatrix that is created when the graphic is moved into the components ViewPoint, ViewVertical, etc. It seemed to me that the front end usually make a discontinuous jump from the view point in the orthographic projection to the initial view point in rotated graphic. Discouraged by this apparent behavior, I opted for a hybrid solution.

I used an ordinary Graphics3D with Dynamic view properties and used Inset to insert the graphics tom2 into it. The view properties of the outer Graphics3D are used to compute a corresponding orthographic projection ViewMatrix to be used to display the graphics tom2. So the mouse rotates the outer graphics and the code rotates the inset tom2 in the same way. The only difference is that tom2 is projected orthographically instead of perspectively.

To do this, I used and adapted code from Heike in this answer and Alexey Popkov in this answer. I needed Alexey Popkov's completePlotRange because AbsoluteOptions would not return the actual plot range.

(* 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}};

(* Alexey Popkov *)
completePlotRange[plot : (_Graphics | _Graphics3D)] := 
 Quiet@Last@
   Last@Reap[
     Rasterize[
      Show[plot, Axes -> True, Ticks -> (Sow[{##}] &), 
       DisplayFunction -> Identity], ImageResolution -> 1]]

(* OP *)
a0 = 1; ceng = 1; znn = 3*ceng; ynn = 5; xnn = 5; a1 = 2; cznn = 3; hh = 2;
p1[θ_] := RotationTransform[θ, {0, 0, 1}];
posx1 = (nx1 - 1) a0 + ((ny1 - 1) a0)/2 + (Mod[nz1 - 1, 3] a0)/2;
posy1 = Sqrt[3]/2 (ny1 - 1) a0 + (Sqrt[3] Mod[nz1 - 1, 3] a0)/6;
posz1 = Sqrt[3]/2 (nz1 - 1) a0 + Floor[(nz1 - 1)/3] a0;
sinpq2 = Transpose[Table[{posx1, posy1, posz1},
                         {ny1, ynn}, {nz1, znn}, {nx1, -xnn, 0}]];
rr = 0.3 a0;
(* updated - switched Graphics3D and Table, adjusted options *)
tom2 = Graphics3D[
   Table[{If[Mod[cc, 3] == 2, Pink, Yellow], Sphere[N@sinpq2[[cc, bb, aa]], rr]},
         {aa, xnn}, {bb, ynn}, {cc, znn}],
   Axes -> False, BoxStyle -> Directive[Orange, Opacity[1]], 
   BoxRatios -> Automatic, Background -> Black];

(* adapted from Heike *)
bb = completePlotRange@tom2;
scale = 1/Abs[#1 - #2] & @@@ bb;
center = Mean /@ bb;
vv = {Flatten[Differences /@ bb] + center, center};
v1 = (vv[[1]] - center);
vert = {0, 0, 1} - {0, 0, 1}.v1 v1;
viewAngle = 2 ArcCot[2.];

(* final graphic *)
Graphics3D[{},
 Epilog -> Inset[
   Show[tom2, 
        ViewMatrix ->
          Dynamic@{tt[v1, vert, center, Cot[viewAngle/2]/Norm[v1], scale], pp},
        PlotRange -> bb],
   Center, Center, 1],
 ViewAngle    -> Dynamic[viewAngle], 
 ViewVector   -> Dynamic[vv, (vv = #; center = vv[[2]]; v1 = vv[[1]] - center) &], 
 ViewVertical -> Dynamic[vert],
 SphericalRegion -> True, PlotRange -> bb, Boxed -> False]

Output after manual rotation:

share|improve this answer
    
I'm sure you don't want to look at this code again... I'm seeing this error: i.stack.imgur.com/cHgNh.png –  cormullion Jul 16 '13 at 22:49
    
A last minute change error. At the last minute I changed Heike's pp was a function to a constant, but only in one of the two places it appeared. Thanks for letting me know! –  Michael E2 Jul 17 '13 at 1:05

Combining some of the ideas here and elsewhere, this appears to produce a parallel projection:

tr = TransformationMatrix[
RescalingTransform[{{-2, 2}, {-2, 2}, {-3/2, 5/2}}]];
p = {{1, 0, 0, 0}, {0, 0, 1, 0}, {0, 1, 0, 0}, {0, 0, 0, 1}};
DynamicModule[{vm = {tr, p}, vp = {0, 0, 100}},
 tom2 = Table[
   Graphics3D[{If[Mod[cc, 3] == 2, Pink, Yellow], 
     Sphere[sinpq2[[cc, bb, aa]], rr]}, 
     ViewMatrix -> Dynamic[vm], 
     ViewPoint -> Dynamic[vp]], 
  {aa, xnn}, {bb, ynn}, {cc, znn}];
 Show[tom2, 
   Axes -> False, 
   BoxStyle -> Directive[Orange, Opacity[0]],
   BoxRatios -> Automatic, 
   PlotRange -> All, 
   Background -> Black]]

which you can test by looking at the columns of spheres end on - there's hardly any perspective at all:

a load of balls

share|improve this answer
    
Rats, I was doing the same thing. If you change the opacity on the box, it's easier to see it's slightly off. The initial settings a reset on rotating the graphics to a perpective that is fairly far away. –  Michael E2 Jul 16 '13 at 13:33
    
@MichaelE2 Yes, it all seems more difficult than necessary. A nice ViewMode -> Cabinet or Cavalier would be cool. (Anyone know those? :) –  cormullion Jul 16 '13 at 13:41

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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