3
$\begingroup$

In the square prism ABCD A1B1C1D1, the bottom side lengths are all equal, where AB=2, and the top and bottom side lengths are all equal, where A1B1=1, and the side edge length AA1=Sqrt[2]

My method is to calculate the height of the prism using known conditions, and how to write the coordinates of each point and draw them.

Clear["Global`*"];
a = {Sqrt[2], 0, 0};
b = {0, Sqrt[2], 0};
c = -a;
d = -b;
o = Mean[{a, b, c, d}]
h = Sqrt[6]/2;
a1 = {Sqrt[2]/2, 0, h};
b1 = {0, Sqrt[2]/2, h};
c1 = {-Sqrt[2]/2, 0, h};
d1 = {0, -Sqrt[2]/2, h};
o1 = Mean[{a1, b1, c1, d1}]
labels = {Text[Style[O, 12, FontFamily -> "Times"], o, {-1, -1}], 
   Text[Style[O1, 12, FontFamily -> "Times"], o1, {-1, -1}], 
   Text[Style[A, 12, FontFamily -> "Times"], a, {-1, -1}], 
   Text[Style[B, 12, FontFamily -> "Times"], b, {1, 1}], 
   Text[Style[C, 12, FontFamily -> "Times"], c, {1, 1}], 
   Text[Style[D, 12, FontFamily -> "Times"], d, {-2, 0}], 
   Text[Style[A1, 12, FontFamily -> "Times"], a1, {3, 0}], 
   Text[Style[B1, 12, FontFamily -> "Times"], b1, {-1, -2}], 
   Text[Style[C1, 12, FontFamily -> "Times"], c1, {0, 1}], 
   Text[Style[D1, 12, FontFamily -> "Times"], d1, {3, 0}]};
dashLines = {Dashed, 
   AbsoluteThickness[2], {Line[{{o, o1}, {d, d1}}]}, {Red, 
    Line[{{c, d}, {a, d}, {b, d}, {a, c}}]}};
realLines = {AbsoluteThickness[2], 
   Line[{{a, b}, {b, b1}, {a1, a}, {b, b1}, {b1, a1}, {c, c1}, {b1, 
      c1}, {c1, d1}, {b, c}, {a1, c1}, {b1, d1}, {a1, d1}}]};
Show[Graphics3D[{dashLines, realLines, labels}, Boxed -> False, 
  ViewPoint -> {2, 3.5, 1.28}], 
 Graphics3D[{Arrow[{{o1 - o, o1 - o + {0, 0, 1}}, {a - o, 
      a - o + {1, 0, 0}}, {b - o, b - o + {0, 1, 0}}}], 
   Text[Style["z", 20, Italic, FontFamily -> "Times"], 
    o1 - o + {0, 0, 1}, {-1, -1}], 
   Text[Style["y", 20, Italic, FontFamily -> "Times"], 
    b - o + {0, 1, 0}, {-2, -1}], 
   Text[Style["x", 20, Italic, FontFamily -> "Times"], 
    a - o + {1, 0, 0}, {2, -1}]}]]

enter image description here

What better method or code optimization is there?

Improve this question
$\endgroup$
4
  • 1
    $\begingroup$ What do you mean by "optimize"? The code seems to work fine, and the graphics appear in a fraction of second. Where is the problem? $\endgroup$
    – Domen
    Commented Jun 12, 2023 at 11:19
  • 1
    $\begingroup$ @Domen I have no problem writing this myself and can draw it. What I mean is to see if everyone has any other methods, with less code and more concise ones. $\endgroup$
    – csn899
    Commented Jun 12, 2023 at 11:21
  • 1
    $\begingroup$ I think it's a good question. I don't have Mathematica at hands at the moment to experiment, but one idea would be to define a function label[text_, coords_] := Text[Style[label, 12, FontFamily -> "Times"], coords, {-1, 1}] and then do e.g. labels = MapThread[label, {{"O", o}, {"O1", o1}, ...}] This would reduce the code duplication a bit. $\endgroup$
    – C. E. ♦
    Commented Jun 12, 2023 at 11:32
  • 3
    $\begingroup$ There is an example in the docs for Hexahedron - see the Applications section ...Create a square frustum parameterized by base width, top width, and height: $\endgroup$
    – flinty
    Commented Jun 12, 2023 at 11:32

2 Answers 2

Reset to default
3
$\begingroup$

Adapting the code from the docs for Hexahedron, you can plug your own values that you solved into this to draw it.

SquareFrustum[wb_, wt_, h_] := With[{
   p1 = {wb/2, 0, 0},
   p2 = {0, wb/2, 0},
   p3 = {-wb/2, 0, 0},
   p4 = {0, -wb/2, 0},
   p5 = {wt/2, 0, h},
   p6 = {0, wt/2, h},
   p7 = {-wt/2, 0, h},
   p8 = {0, -wt/2, h}}, {{Red, Dashed, Line[{p1, p3}], 
    Line[{p2, p4}]}, Line[{p5, p7}], Line[{p6, p8}], FaceForm[None], 
   EdgeForm[Blue], Hexahedron[{p1, p2, p3, p4, p5, p6, p7, p8}]}]

Graphics3D[{SquareFrustum[1, 1/2, 3/4]}, Axes -> True]

enter image description here

Improve this answer
$\endgroup$
3
$\begingroup$

Simplify the main code.

reg = ConvexHullRegion[{a, b, c, d, a1, b1, c1, d1}];
Graphics3D[{EdgeForm[Blue], FaceForm[], reg, 
  Line[{o1, #}] & /@ {a1, b1, c1, d1}, Dashed, Red, 
  Line[{o, #}] & /@ {a, b, c, d}}, Boxed -> False]

enter image description here

Improve this answer
$\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.