Manipulate + ListPlot3D +...

[Ossama Kullie]

Dear Mathematica user,

I have the following graphics,

--------------------------------------------cut here

R =.; \[Alpha] =.;
LuF3Csa[R_, \[Alpha]_] := {{0 , 0, 0}, {(2*R*Sin[\[Alpha]/2])/Sqrt[3],
0, -(Sqrt[R^2*(1 + 2*Cos[\[Alpha]])]/
Sqrt[3])}, {-(R*Sin[\[Alpha]/2])/Sqrt[3],
R*Sin[\[Alpha]/2], -(Sqrt[R^2*(1 + 2*Cos[\[Alpha]])]/
Sqrt[3])}, {-(R*Sin[\[Alpha]/2])/Sqrt[3], -R*
Sin[\[Alpha]/2], -(Sqrt[R^2*(1 + 2*Cos[\[Alpha]])]/Sqrt[3])}}

CreateDocument[{Manipulate[
ListPlot3D[{LuF3Csa[1.9745, \[Alpha]],
Table[{x, 0, z}, {x, -1, 2}, {z, -1, 0}]},
PlotStyle -> {PointSize[0.05]}, AxesOrigin -> {0, 0, 0},
PlotStyle -> {PointSize[0.05]}, AxesOrigin -> {0, 0, 0},
MeshStyle -> Yellow, Axes -> True, Boxed -> True,
PlotRangePadding -> None, PlotRange -> All], {\[Alpha],
110 (Pi/180), 2 Pi/3},
Control[{\[Alpha], {105 (Pi/180), 110 (Pi/180), 115 (Pi/180),
2 Pi/3}}]], Button["Close", NotebookClose[]]},
WindowSize -> {700, 700}]

--------------------------------------------------------------

It is the molecule LuF3 with a pyramid shape geometry. I want to
include the atoms, point-like at the four top points of the pyramids,
which can move with the shape pf the molecule when the structure of
the molecules changes with manipulate.
Can you help me please?

Best Regards,
O. Kullie

[dh]

Hi Ossama,

you may add the additional points with e.g.:

Graphics3D[Sphere[#, 0.1] & /@ LuF3Csa[1.9745, \[Alpha]]]

and use Show to combine it with the other graphics.

Note that the lower level of alpha and the specification of Control[..]

are conflicting. I set the lower level in agreement with Control[..]

==================================

R =.; \[Alpha] =.;

LuF3Csa[R_, \[Alpha]_] := {{0, 0, 0}, {(2*R*Sin[\[Alpha]/2])/Sqrt[3],

0, -(Sqrt[R^2*(1 + 2*Cos[\[Alpha]])]/

Sqrt[3])}, {-(R*Sin[\[Alpha]/2])/Sqrt[3],

R*Sin[\[Alpha]/2], -(Sqrt[R^2*(1 + 2*Cos[\[Alpha]])]/

Sqrt[3])}, {-(R*Sin[\[Alpha]/2])/Sqrt[3], -R*

Sin[\[Alpha]/2], -(Sqrt[R^2*(1 + 2*Cos[\[Alpha]])]/Sqrt[3])}}

CreateDocument[{Manipulate[

Show[ListPlot3D[{LuF3Csa[1.9745, \[Alpha]],

Table[{x, 0, z}, {x, -1, 2}, {z, -1, 0}]},

PlotStyle -> {PointSize[0.05]}, AxesOrigin -> {0, 0, 0},

PlotStyle -> {PointSize[0.05]}, AxesOrigin -> {0, 0, 0},

MeshStyle -> Yellow, Axes -> True, Boxed -> True,

PlotRangePadding -> None, PlotRange -> All],

Graphics3D[

Sphere[#, 0.1] & /@ LuF3Csa[1.9745, \[Alpha]]]], {\[Alpha],

105 (Pi/180), 2 Pi/3},

Control[{\[Alpha], {105 (Pi/180), 110 (Pi/180), 115 (Pi/180),

2 Pi/3}}]], Button["Close", NotebookClose[]]},

WindowSize -> {700, 700}]

==================================

Daniel

[Sjoerd C. de Vries]

Hi Ossamma,

try this:

CreateDocument[
{
Manipulate[
Show[
{

ListPlot3D[{LuF3Csa[1.9745, \[Alpha]],
Table[{x, 0, z}, {x, -1, 2}, {z, -1, 0}]},
PlotStyle -> {PointSize[0.05]}, AxesOrigin -> {0, 0, 0},
PlotStyle -> {PointSize[0.05]}, AxesOrigin -> {0, 0, 0},
MeshStyle -> Yellow, Axes -> True, Boxed -> True,
PlotRangePadding -> None, PlotRange -> All
],

Graphics3D[{PointSize[0.05], Point[LuF3Csa[1.9745, \[Alpha]]]}]

}
],
{\[Alpha], 110 (Pi/180), 2 Pi/3},
Control[{\[Alpha], {105 (Pi/180), 110 (Pi/180), 115 (Pi/180),
2 Pi/3}}]
],
Button["Close", NotebookClose[]]
}, WindowSize -> {700, 700}
]

Cheers -- Sjoerd

[Ossama Kullie]

Thank you a lot for all your suggestions,

I think the following seems ok ?

---------------------------------------

CreateDocument[{Manipulate[
Show[ListPointPlot3D[LuF3Csa[1.9745, \[Alpha]],
PlotStyle -> {AbsolutePointSize[15]},
ColorFunction -> Function[{x, y, z}, Hue[x]],

AxesOrigin -> {0, 0, 0}],

ListPlot3D[{LuF3Csa[1.9745, \[Alpha]],

Table[{x, 0, z}, {x, -1, 2}, {z, -1, 0}]}, MeshStyle -> Yellow,

Axes -> True, Boxed -> True, PlotRangePadding -> None,

PlotRange -> All]], {\[Alpha], 100 (Pi/180), (2 Pi/3)},
Control[{\[Alpha], Table[n*(Pi/180), {n, 100, 120, 5}]}]],

Button["Close", NotebookClose[]]}, WindowSize -> {700, 700}]

------------------------------------------------
Best Regards,
Ossama kullie