# What is a quick way to draw a regular pyramid?

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}]


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?

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]] ]


One easy way is to use PolyhedronData

PolyhedronData[{"Pyramid", 4}]


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]


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}]


\$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]


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]) *)
`