1
$\begingroup$

In the regular pyramid P-ABCD, where PA = AB = 2, sketch its figure and calculate its volume.

Clear["`*"]
a = {0, 0, 0};
b = {2, 0, 0};
c = {2, 2, 0};
d = {0, 2, 0};
p = {1, 1, Sqrt[2]};
pyramid = 
 Graphics3D[Polyhedron[{{a, b, p}, {b, c, p}, {c, d, p}, {d, a, p}}], 
  Axes -> True, Boxed -> False, ViewPoint -> {1.5, -2.4, 1}]

enter image description here

The coordinates of the four points on the base ABCD are easier to calculate, while determining the coordinates of the vertex P p = {1, 1, Sqrt[2]}is slightly more complicated.

Is there a more efficient way to draw a regular pyramid with equal side lengths, without having to calculate the coordinates of each vertex, by simply entering the edge length?

$\endgroup$

4 Answers 4

5
$\begingroup$
Clear[a, b, c, d, p];
a = {0, 0, 0};
b = {2, 0, 0};
c = {2, 2, 0};
d = {0, 2, 0};
p = {x, y, z};
sol = ToRules /@ 
  Reduce[{EuclideanDistance[p, a] == EuclideanDistance[p, b] == 
     EuclideanDistance[p, c] == EuclideanDistance[p, d] == 2}, {x, y, 
    z}, Reals]

{x -> 1, y -> 1, z -> -Sqrt[2]} || {x -> 1, y -> 1, z -> Sqrt[2]}

Graphics3D[ConvexHullMesh[{p, a, b, c, d} /. sol[[2]]]]
ConvexHullRegion[{p, a, b, c, d} /. sol[[2]] ] 

enter image description here

$\endgroup$
5
$\begingroup$

One easy way is to use PolyhedronData

PolyhedronData[{"Pyramid", 4}]

enter image description here

You can access other properties:

PolyhedronData[{"Pyramid", 4}, "VertexCoordinates"]
(* 
   {{0, 0, 1/Sqrt[2]}, 
    {0, -(1/Sqrt[2]), 0}, 
    {0, 1/Sqrt[2], 0}, 
    {-(1/Sqrt[2]), 0, 0}, 
    {1/Sqrt[2], 0, 0}} 
*)

PolyhedronData[{"Pyramid", 4}, "Volume"]
(* 1/(3*Sqrt[2]) *)

Now, this will be Mathematica's canonical form, which means the side lengths and orientation will be different than your target. Nevertheless, it should be pretty easy for you to do the transformations you need. For example, once you have the vertices, you can apply scaling and rotation functions to get them exactly where you want them.

For example:

MyPyramid[sidelength_] := 
  ConvexHullRegion[
    (ScalingTransform[sidelength {1, 1, 1}]@*
     TranslationTransform[{1/2, 1/2, 0}]@*
     RotationTransform[Pi/4, {0, 0, 1}])@
     PolyhedronData[{"Pyramid", 4}, "VertexCoordinates"]]


Volume[MyPyramid[2]]
(* (4*Sqrt[2])/3 *)

MeshCoordinates[MyPyramid[2]]
(* {{1., 1., 1.41421}, {2., 0., 0.}, {0., 2., 0.}, {0., 0., 0.}, {2., 2., 0.}} *)

With MeshPrimitives you can get edges, faces, and vertices as geometric "objects". And you can visualize:

Graphics3D[MyPyramid[2], Axes -> True]

enter image description here

$\endgroup$
1
$\begingroup$
Clear["`*"]
a = {0, 0, 0};
b = {2, 0, 0};
c = {2, 2, 0};
d = {0, 2, 0};
base = EuclideanDistance[a, b];
slant = 2;
h = Sqrt[slant^2 - (base Sqrt[2]/2)^2];
    
    
p = {base/2, base/2, h};
pyramid = 
 Graphics3D[Pyramid[{a, b, c, d, p}], Axes -> True, Boxed -> False, 
  ViewPoint -> {1.5, -2.4, 1}]

enter image description here

$\endgroup$
1
$\begingroup$
$Version

(* "14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)" *)

Clear["Global`*"]

pts[l_] = {{0, 0, 0}, {l, 0, 0}, {l, l, 0}, {0, l, 0}, {l/2, l/2, l/Sqrt[2]}};

len = 2;

Graphics3D[pyr = Pyramid[pts[len]], Axes -> True]

enter image description here

And @@ (EuclideanDistance[Last@pts[len], #] == len & /@ Most[pts[len]])

(* True *)

Volume@pyr

(* (4 Sqrt[2])/3 *)

In general,

len = l;

Volume@Pyramid[pts[len]] // Simplify[#, l > 0] &

(* l^3/(3 Sqrt[2]) *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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