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.

As the title says, I want to add some text in a three-dimensional plot, thus labeling specific parts of it. Here is the corresponding Mathematica code

V = 1/2*(x^2 + y^2 + z^2) + (x^2*y^2 + x^2*z^2 + y^2*z^2 - x^2*y^2*z^2);

E0 = 8.5;

S0 = ContourPlot3D[V == E0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}, 
PlotPoints -> 100, PerformanceGoal -> "Speed", Mesh -> None, 
ContourStyle -> Directive[Green, Opacity[0.3], Specularity[White, 30]], 
ImageSize -> 550, RegionFunction -> Function[{x, y, z}, 
Sqrt[x^2*y^2 + x^2*z^2 + y^2*z^2] <= 4]]

which gives this output

plot3D

This surface contains eight symmetrical openings (holes) which I want to label using numbers 1, 2, ...., 8. Any suggestions how to do that? Would it be possible to "reduce" and project this surface into a two-dimensional plot in order to insert the labels? I suppose this would be interpreted more easily.

share|improve this question
    
@Kuba Just inserting text close to that holes. However, since you mentioned the location of the openings, I wouldn't say no to a way finding their coordinates! –  Vaggelis_Z Sep 30 '13 at 7:27

2 Answers 2

up vote 8 down vote accepted

Let's assume that this expression doesn't have a simple form and that we can only work on the plot.

The only lines in the plot are those that come from the holes' boundaries, so we can extract them:

holes = Cases[S0 // Normal, Line[x__] :> x, Infinity];
pos = 1.2 (Mean /@ holes);
labels = Table[Inset[Style["Label " <> ToString[i], Bold, 20], pos[[i]]], 
                {i, Length@holes}];

Show[S0, Graphics3D[labels]]

enter image description here

Of course, you can calculate anatically what you need. It's just a different approach. Also, I've used Inset instead of Text so the labels can be covered by the plot and not always be in front.


Edit

in response to the comment:

order = Ordering @ {6, 8, 4, 2, 5, 7, 3, 1};
labels = Table[Inset[Style[order[[i]], Bold, 25], pos[[i]]], {i, Length@holes}];

enter image description here

share|improve this answer
    
Very close to what I want! One minor drawback though, the numbering of the labels is automatic. How can I define my own sequence of numbers? In your case, 6,8,4,2,5,7,3,1 should be 1,2,3,4,5,6,7,8. –  Vaggelis_Z Sep 30 '13 at 7:49
    
lost a little bit! could you incorporate the above patch to your original code? –  Vaggelis_Z Sep 30 '13 at 8:03
    
@Vaggelis_Z done. –  Kuba Sep 30 '13 at 8:09
    
I figured it out before your update! However, something is not right! 6,8,4,2,5,7,3,1 are now 1,5,8,2,4,6,3,7 instead of 1,2,3,4,5,6,7,8! Why? –  Vaggelis_Z Sep 30 '13 at 8:13
    
@Vaggelis_Z I messed up with the order. It should be order = Ordering@{6, 8, 4, 2, 5, 7, 3, 1} –  Kuba Sep 30 '13 at 8:18

It seems that you want to add text to the 3D graphics. Therefore, using Epilog is not recommended, because it contains graphics primitives which are added after the 3D image is projected onto the 2D image plane. This is the reason why only two-dimensional primitives are possible in Epilog.

An easy solution to your problem is to create another 3D graphics containing your text and join both using Show

Show[S0, Graphics3D[Text[Framed@Style["MyLabel", Bold, 18], {2, -2, 2}]]]

Mathematica graphics

Determination of the correct points

I kind of misread your question and thought you are you are only interested in a way to combine labels and 3D plot. Therefore, here an update on how you can determine the midpoints of your wholes.

Basically, it is exactly what you already used in your graphics: you determine where your contour function and the region function have common points. Due to the high symmetry of your equation, let me propose the following:

eq = {1/2*(x^2 + y^2 + z^2) + (x^2*y^2 + x^2*z^2 + y^2*z^2 - 
       x^2*y^2*z^2) == E0, 
   Sqrt[x^2*y^2 + x^2*z^2 + y^2*z^2] == 4} /. {z :> x};

pt = Mean[Select[
    Chop[N[{x, y, x} /. Solve[eq, {x, y}]]], 
    FreeQ[#, Complex] && Min[#] > 0 &]];

midPoints = pt*# & /@ Tuples[{-1, 1}, {3}];

This results in the following midPoints which you could use as label positions

Mathematica graphics

share|improve this answer
    
Nice approach! BTW, what's the exact ViewPoint you used? –  Vaggelis_Z Sep 30 '13 at 7:44
    
@Vaggelis_Z I misread your question. Please see my edit. –  halirutan Sep 30 '13 at 8:13
    
Could you give me the exact ViewPoint of the two posted 3D plots? I cannot find the correct triplet and your choice is the best! –  Vaggelis_Z Sep 30 '13 at 10:32
    
@Vaggelis_Z For the first graphic it is {0.0653668, -3.25175, 0.933735} and for the second one it is {0.553949, 1.15298, 3.13269}. But I haven't done anything special! I just rotated the graphics a bit so that I liked the view. –  halirutan Sep 30 '13 at 11:54
    
I did not say it is something special. However, without knowing the exact triplet, one cannot replicate the view adjusted by the user rotating the plot with the mouse. –  Vaggelis_Z Sep 30 '13 at 13:21

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.