Rhombohedron

Author

Eric W. Weisstein
March 7, 2009

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/Rhombohedron.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Rhombohedron.html.

©2009 Wolfram Research, Inc. except for portions noted otherwise

Graphic

PolyhedronData["Rhombohedron"]

V5

Show[GraphicsArray[Graphics3D[Rhombohedron[#],Boxed->False]&/@{{0,1},{1,2}/Sqrt[5],{1,1}}
]]

V8

GraphicsGrid[{Show[PolyhedronData[#],PlotLabel->TextCell[PolyhedronData[#,"Name"],PageWidth->130,TextAlignment->Center],Boxed->False,BaseStyle->Italic]&/@PolyhedronData["Rhombohedron"]},ImageSize->400]

LiveGraphics3D

<<LiveGraphics3D`

WriteLiveForm["rhomboh1.m",Show[Graphics3D[Rhombohedron[{0,1}],Boxed->False]]]

WriteLiveForm["rhomboh2.m",Show[Graphics3D[Rhombohedron[{1,2}],Boxed->False]]]

WriteLiveForm["rhomboh3.m",Show[Graphics3D[Rhombohedron[{1,1}],Boxed->False]]]

Vertices

v=PolyhedronVertices[Polyhedron[Rhombohedron[{x,y}]]]

TraditionalForm/@(FullSimplify[v,x>0&&y>0]/.(Sqrt[(x^2)+(y^2)])->r /.(r-x)->s y/x/.(Sqrt[-2 (x^4)+2 r (x^3)-(y^2) (x^2)+(y^4)])-> y t//Simplify)//TraditionalForm

Solve[(r-x)==s y/x,s]

Construction

Simplify[Norm/@Subtract@@@Partition[{{0,0},{(Sqrt[(p^2)+(q^2)]),0},{p+(Sqrt[(p^2)+(q^2)]),q},{p,q}},2,1,1],p>0&&q>0]

q

Solve[{
x^2+y^2+z^2==(p^2)+(q^2),
(x-p)^2+(y-q)^2+z^2==(((p-(Sqrt[(p^2)+(q^2)])))^2)+(q^2),
(((x-(Sqrt[(p^2)+(q^2)])))^2)+(y^2)+(z^2)==(((p-(Sqrt[(p^2)+(q^2)])))^2)+(q^2)
},{x,y,z}]//FullSimplify

soln={x,y,z}/.%

Append[Norm/@soln,(Sqrt[(p^2)+(q^2)])]/.{p->1.3,q->.2}

r[{p_,q_}]:=Module[{x=p,y=((p ((Sqrt[(p^2)+(q^2)])-p))/q),z=(Sqrt[((-2 (p^4)-(p^2) (q^2)+(q^4)+2 (p^3) (Sqrt[(p^2)+(q^2)]))/(q^2))]),
o={0,0,0},p1,p2,p3,v,v2,v3,v4,xyz
},
v4={p,q,0};
v3={p+(Sqrt[(p^2)+(q^2)]),q,0};
v2={(Sqrt[(p^2)+(q^2)]),0,0};
v={x,y,z};
Polygon/@{
p1={o,v4,v3,v2},
#+v&/@p1,
p3={o,v,v2+v,v2},
#+v4&/@p3,
p2={o,v,v4+v,v4},
#+v2&/@p2
}
]

r[{.2,.3}]

Graphics3D[r[{.2,.3}][[All]]]

With[{p=.5,q=.3},r[{p,q}]/.Polygon[v_]:>Norm/@(Subtract@@@Partition[v,2,1,1])]

FullSimplify[r[{p,q}]/.Polygon[v_]:>Norm/@(Subtract@@@Partition[v,2,1,1]),p>0&&q>0]

%//Flatten//Union