3
$\begingroup$

The original idea is from: http://demonstrations.wolfram.com/ClickACountry/

What I'm trying to do is to create a series of Graphics3D objects and let them control the display of corresponding Graphics3D objects in a different Pane and maintain the Graphics3D feature at the same time.

My first try was simple. I initialized an empty list to store the objects I want to display. When I click the certain sphere in the picture, it will append itself to the display list if there's no duplication in the list. If I click it again, it will remove itself from display list so that itself will hide from the pane. enter image description here

enter image description here

As what the sample picture shows, four spheres are still kept in one Graphics3D field, you can still rotate or move the spheres. When I click the blue sphere and red sphere, the new sphere will display at the corresponding location.

Therefore, I tried to implement the feature as the code below:

Manipulate[
 With[{Solar = {Graphics3D[{Blue, 
       Sphere[{0.5*Cos[0], 0.5*Sin[0], 0}, 0.2]}, Boxed -> False],
     Graphics3D[{Green, Sphere[{1*Cos[0], 1*Sin[0], 0}, 0.2]}, 
      Boxed -> False],
     Graphics3D[{Red, Sphere[{1.5*Cos[0], 1.5*Sin[0], 0}, 0.2]}, 
      Boxed -> False],
     Graphics3D[{Orange, Sphere[{2*Cos[0], 2*Sin[0], 0}, 0.2]}, 
      Boxed -> False]}},
   Column[{
     Graphics3D[{
       Map[If[FreeQ[u, #[[1]]],
          Button[#[[1]], AppendTo[u, #[[1]]]], 
          Button[#[[1]], u = DeleteCases[u, #[[1]]]]] &, Solar]}, 
      ImageSize -> 300, Boxed -> False],
     Row[{Pane[Graphics3D[{#}, Boxed -> False], {300, 300}, 
          Alignment -> {Center, Center}]}] &[Union@u]}]],
 {{u, {}}, ControlType -> None}, SaveDefinitions -> True]

Then I tried further implementation:

Manipulate[
 With[{Models = {{
      Graphics3D[{Blue, Sphere[{0.5*Cos[0], 0.5*Sin[0], 0}, 0.2]}, 
       Boxed -> False],
      SphericalPlot3D[
       1 + 2 Cos[2 θ], {θ, 0, π}, {ϕ, 0, 
        2 π}, PlotStyle -> Blue, Mesh -> None, Boxed -> False, 
       Axes -> False]
      },
     {
      Graphics3D[{Red, Sphere[{1*Cos[0], 1*Sin[0], 0}, 0.2]}, 
       Boxed -> False],
      SphericalPlot3D[
       Evaluate@
        Abs@SphericalHarmonicY[3, 1, θ, ϕ], {θ, 
        0, π}, {ϕ, 0, 2 π}, PlotStyle -> Red, 
       Mesh -> None, Boxed -> False, Axes -> False]
      },
     {
      Graphics3D[{Green, Sphere[{1.5*Cos[0], 1.5*Sin[0], 0}, 0.2]}, 
       Boxed -> False],
      ParametricPlot3D[{Cos[
          u] (3 + Cos[u/2] Sin[v] - Sin[u/2] Sin[2 v]), 
        Sin[u] (3 + Cos[u/2] Sin[v] - Sin[u/2] Sin[2 v]), 
        Sin[u/2] Sin[v] + Cos[u/2] Sin[2 v]}, {u, 0, 2 Pi}, {v, 0, 
        2 Pi}, PlotStyle -> FaceForm[Green, Green], Mesh -> None, 
       Boxed -> False, Axes -> False]
      },
     {
      Graphics3D[{Orange, Sphere[{2*Cos[0], 2*Sin[0], 0}, 0.2]}, 
       Boxed -> False],
      RevolutionPlot3D[{2 + Cos[t], Sin[t]}, {t, 0, 2 Pi}, 
       PlotStyle -> Orange, Mesh -> None, Boxed -> False, 
       Axes -> False]
      }}},
  Column[{
    Graphics3D[{
      If[FreeQ[u, #[[2]]],
         Button[#[[1]], AppendTo[u, #[[2]]]], 
         Button[#[[1]], u = DeleteCases[u, #[[2]]]]] & /@ 
       Models}, ImageSize -> 300, Boxed -> False],
    Row[{Pane[Graphics3D[{#}, Boxed -> False], {300, 300}, 
         Alignment -> {Center, Center}]}] &[Union@u]}]], {{u, {}}, 
  ControlType -> None}, SaveDefinitions -> True]

Next I tried to display the different corresponding objects, so I set up a Models list to store the corresponding pairs. Therefore, when I click a sphere, it will append/delete the corresponding objects. However, I keep getting the error:

"Graphics is not a Graphics3D directive."

I'm confused because neither of the objects are Graphics type. I'm guessing there is some conflict between the objects pairs when I append those sphere buttons.

Edit

( by m_goldberg)

Here is the OP's code redacted to something much closer to a minimal working example. I hope it will make the OP's problem more accessible to other Mathematica.SE participants.

Manipulate[
  Column[{
    Graphics3D[
      Map[
        If[FreeQ[u, #[[1]]], 
          Button[#[[1]], AppendTo[u, #[[1]]]], 
          Button[#[[1]], u = DeleteCases[u, #[[1]]]]] &, 
        Solar], 
      ImageSize -> 300, Boxed -> False], 
    Graphics3D[u, 
      ImageSize -> 300, Boxed -> False]}],
  {{u, {}}, ControlType -> None},
  Initialization :> (
    Solar = 
      {Graphics3D[{Blue, Sphere[{0.5, 0., 0.}, 0.2]}, Boxed -> False], 
       Graphics3D[{Green, Sphere[{1., 0., 0.}, 0.2]}, Boxed -> False], 
       Graphics3D[{Red, Sphere[{1.5, 0., 0.}, 0.2]}, Boxed -> False], 
       Graphics3D[{Orange, Sphere[{2., 0., 0.}, 0.2]}, Boxed -> False]}),
  SaveDefinitions -> True]
$\endgroup$
  • $\begingroup$ With your recent edit, I have a better understanding of what you are trying to achieve. Accomplishing the same effect when the button graphics and the model graphics are not the same objects will require more thought on my part. As I write this, I don't have a ready solution. If I come up with a solution I will post it. $\endgroup$ – m_goldberg Jul 7 '15 at 20:52
  • $\begingroup$ From what you have provided, I did a little change, but what I have done now only works one object. $\endgroup$ – Lingbo Tang Jul 7 '15 at 21:04
4
$\begingroup$

Edit

In my opinion, what is asked for is more easily done when the button graphics and the model graphics are kept in separate lists.

Manipulate[
  Column[{
    Graphics3D[
      MapIndexed[
        If[FreeQ[u, models[[#2[[1]]]]], 
          Button[#[[1]], AppendTo[u, models[[#2[[1]]]]]], 
          Button[#[[1]], u = DeleteCases[u, models[[#2[[1]]]]]]] &, 
        solar],
      ImageSize -> 300, Boxed -> False],
    Graphics3D[u,
      ImageSize -> 300, Boxed -> False]}],
  {{u, {}}, None},
  {solar, None},
  {models, None},
  Initialization :> (
    solar = 
      {Graphics3D[{Blue, Sphere[{0.5, 0., 0.}, 0.2]}], 
       Graphics3D[{Red, Sphere[{1., 0., 0.}, 0.2]}],
       Graphics3D[{Green, Sphere[{1.5, 0., 0.}, 0.2]}], 
       Graphics3D[{Orange, Sphere[{2., 0., 0.}, 0.2]}]};
    models =
      MapThread[
        Translate[#1[[1]], {#2, 0, 0}] &, 
        {{SphericalPlot3D[1.2 (1 + 2 Cos[2 θ]), {θ, 0, π}, {ϕ, 0, 2 π}, 
            PlotStyle -> Blue, Mesh -> None],
          SphericalPlot3D[8. Abs @ SphericalHarmonicY[3, 1, θ, ϕ], 
            {θ, 0, π}, {ϕ, 0, 2 π},
            PlotStyle -> Red, Mesh -> None],
          ParametricPlot3D[{
            Cos[u] (3 + Cos[u/2] Sin[v] - Sin[u/2] Sin[2 v]), 
            Sin[u] (3 + Cos[u/2] Sin[v] - Sin[u/2] Sin[2 v]), 
            Sin[u/2] Sin[v] + Cos[u/2] Sin[2 v]}, 
            {u, 0, 2 Pi}, {v, 0, 2 Pi}, 
            PlotStyle -> Green, Mesh -> None],
          RevolutionPlot3D[{2 + Cos[t], Sin[t]}, {t, 0, 2 Pi}, 
            PlotStyle -> Orange, Mesh -> None]}, 
         10 Range[0, Length[solar] - 1]}]),
  TrackedSymbols :> {u}]![demo][2]

demo1

And, yes, you can rotate each row of objects and the top row acts as buttons to show or hide the objects in the bottom row. Here is a rotated view.

demo2

$\endgroup$
  • $\begingroup$ Actually, I want to keep the graphics3D feature like rotate. If you just make it as a texture of the button, it will lose the feature $\endgroup$ – Lingbo Tang Jul 7 '15 at 6:44
  • $\begingroup$ @LingboTang. I don't understand your comment. I didn't make anything the texture of a button. I didn't use textures at all. $\endgroup$ – m_goldberg Jul 7 '15 at 6:49
  • $\begingroup$ I want to keep all spheres in one Graphics3D field but at different location {0.5,0,0},{1,0,0},{1.5,0,0},{2,0,0},which allows me to rotate four spheres as well as control the display of corresponding models. $\endgroup$ – Lingbo Tang Jul 7 '15 at 7:00
  • $\begingroup$ @LingboTang. I can not visualize what you are trying to accomplish by rotating buttons. I do not think I can help you unless you can edit your question in way that makes your ultimate goal clear. $\endgroup$ – m_goldberg Jul 7 '15 at 8:07
  • $\begingroup$ I'll edit it now. $\endgroup$ – Lingbo Tang Jul 7 '15 at 15:40
1
$\begingroup$

I figure out another way that allows you to compose the display graphics objects. This feature will probably satisfy some different requirement. If you want to control the display of a molecule, this answer could help.

The idea is similar to the discussion above.

Manipulate[
 Column[{
   Graphics3D[
    MapThread[
     If[
       FreeQ[u, #2[[1]]],
       Button[#1[[1]], AppendTo[u, #2[[1]]]],
       Button[#1[[1]], u = DeleteCases[u, #2[[1]]]]] &,
     {Solar, models}], ImageSize -> 300, Boxed -> False],
   Graphics3D[u, Boxed -> False]
   }],
 {{u, {}}, ControlType -> None},
 Initialization :> (Solar = {
     Graphics3D[{Blue, Sphere[{0.5, 0., 0.}, 0.2]}, Boxed -> False],
     Graphics3D[{Red, Sphere[{1., 0., 0.}, 0.2]}, Boxed -> False],
     Graphics3D[{Green, Sphere[{1.5, 0., 0.}, 0.2]}, Boxed -> False],
     Graphics3D[{Orange, Sphere[{2., 0., 0.}, 0.2]}, Boxed -> False]};
   models = {
     SphericalPlot3D[
      1.2 (1 + 2 Cos[2 \[Theta]]), {\[Theta], 0, \[Pi]}, {\[Phi], 0, 
       2 \[Pi]}, PlotStyle -> Blue, Mesh -> None], 
     SphericalPlot3D[
      8. Abs@SphericalHarmonicY[3, 1, \[Theta], \[Phi]], {\[Theta], 
       0, \[Pi]}, {\[Phi], 0, 2 \[Pi]}, PlotStyle -> Red, 
      Mesh -> None], 
     ParametricPlot3D[{Cos[
         u] (3 + Cos[u/2] Sin[v] - Sin[u/2] Sin[2 v]), 
       Sin[u] (3 + Cos[u/2] Sin[v] - Sin[u/2] Sin[2 v]), 
       Sin[u/2] Sin[v] + Cos[u/2] Sin[2 v]}, {u, 0, 2 Pi}, {v, 0, 
       2 Pi}, PlotStyle -> Green, Mesh -> None],
     RevolutionPlot3D[{2 + Cos[t], Sin[t]}, {t, 0, 2 Pi}, 
      PlotStyle -> Orange, Mesh -> None, Boxed -> False]}),
 SaveDefinitions -> True]

In this way the results will look like:

enter image description here

If you want to display them separately, I think the first answer is the best way. Note that you can't simply use Translate function, because Translate is a Graphics primitive not Graphics3D primitive.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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