How can drawing this cone always show code running?

Question

The vertex of the cone is P, the center of the base circle is O, AB is the diameter of the base, the angle APB is 120 degrees, AP=2, point C is on the circumference of the base, and the dihedral angle P-AC-O is 45 degrees

Clear["Global`*"];
r=Sqrt[3];h=1;
o={0,0,0};p={0,0,h};\[Alpha]=180 Degree;
circle[t_]=r {Cos[t],Sin[t],0};
b=circle[0];
a=circle[0+\[Alpha]];
c={x,y,z};
c=SolveValues[{(c-a) . (b-c)==0,Abs[Cos[VectorAngle[Cross[p-a,p-c],Cross[a-o,a-c]]]]==Cos[45 Degree],z==0},{x,y,z}]//First
labels={Text[Style[O,12,FontFamily->"Times"],o,{2,-1}],Text[Style[A,12,FontFamily->"Times"],a,{2,-1}],Text[Style[B,12,FontFamily->"Times"],b,{1,2}],Text[Style[C,12,FontFamily->"Times"],c,{-2,0}],Text[Style[P,12,FontFamily->"Times"],p,{-2,0}]};
cir=ParametricPlot3D[circle[t],{t,0,2 \[Pi]},Mesh->{{\[Pi]}},MeshShading->{Directive@{Dashed,Black},Black}];
dashLines={Dashed,AbsoluteThickness[2],Line[{{o,p},{a,b},{a,c},{b,c}}]};
realLines={AbsoluteThickness[2],Line[{{a,p},{b,p}}]};
boundaryLines={AbsoluteThickness[2],Line[{{a,p},{b,p}}]};
Show[Graphics3D[{dashLines,realLines,boundaryLines,labels}],cir,Boxed->False,Axes->False,ViewPoint->{-0.29,-3.26,0.84}]

score 6 · Accepted Answer · answered Aug 27 '23 at 12:53

Compute the coordinates of point c,the length of the sides bc and ac and the volume of the cone.

Clear["Global`*"];
r = Sqrt[3];
h = 1;
o = {0, 0, 0};
c = r {Cos[t], Sin[t], 0};
b = {r, 0, 0};
a = {-r, 0, 0};
p = {0, 0, h};
sol = Solve[{VectorAngle[Cross[c - b, a - b], 
       Cross[c - p, a - p]] == π/4, 0 <= t <= π}, t, 
    Reals][[1]];
c = c /. sol // FullSimplify
{bc, ac} = {EuclideanDistance[b, c], EuclideanDistance[a, c]} // 
  FullSimplify
Volume[Cone[{o, p}, r]]

Animate (https://mathematica.stackexchange.com/a/289169/72111)

labels = {Text[Style[O, 12, FontFamily -> "Times"], o, {2, -1}], 
  Text[Style[A, 12, FontFamily -> "Times"], a, {2, -1}], 
  Text[Style[B, 12, FontFamily -> "Times"], b, {1, 2}], 
  Text[Style[C, 12, FontFamily -> "Times"], c, {-2, 0}], 
  Text[Style[P, 12, FontFamily -> "Times"], p, {-2, 0}]};
ani = Manipulate[
 DynamicModule[{point = N[10 {Cos[θ], Sin[θ], .2}], 
   vertical = {0, 0, 1}, angle = 7 Degree}, 
  Overlay[Graphics3D[{#, labels}, Boxed -> False, 
      Lighting -> AmbientLight[GrayLevel[.8]], 
      ViewPoint -> Dynamic@point, ViewVertical -> Dynamic@vertical, 
      ViewAngle -> Dynamic@angle] & /@ {{EdgeForm[
       AbsoluteThickness[3]], 
      Cone[{o, p}, r]}, {EdgeForm[
       Directive@{AbsoluteThickness[1], 
         AbsoluteDashing[{2, 7}, 0, "Round"]}], FaceForm[], 
      AbsoluteThickness[1], AbsoluteDashing[{2, 7}, 0, "Round"], 
      Line[{a, b}], Line[{o, p}], Line[{a, c}], Line[{b, c}], 
      Cone[{o, p}, r]}}, All, 1]], {{θ, 5}, 0, 2 π}]

Draw this dynamic picture to know that the three points on the bottom surface are not fixed. The original code is stuck here to calculate a good result, is an indefinite equation. — csn899, Aug 27 '23 at 13:22

score 5 · Answer 2 · answered Aug 27 '23 at 11:50

r = Sqrt[3]; h = 1;
o = {0, 0, 0}; p = {0, 0, h}; \[Alpha] = 180 Degree;
circle[t_] = r {Cos[t], Sin[t], 0};
b = circle[0];
a = circle[0 + \[Alpha]];
cc = {x, y, z};
c = SolveValues[{(cc - a) . (b - cc) == 0, 
     ComplexExpand@
       Abs[Cos[VectorAngle[Cross[p - a, p - cc], 
          Cross[a - o, a - cc]]]] == Cos[45 Degree], z == 0}, {x, y, 
     z}] // First;
labels = {Text[Style[O, 12, FontFamily -> "Times"], o, {2, -1}], 
   Text[Style[A, 12, FontFamily -> "Times"], a, {2, -1}], 
   Text[Style[B, 12, FontFamily -> "Times"], b, {1, 2}], 
   Text[Style[C, 12, FontFamily -> "Times"], c, {-2, 0}], 
   Text[Style[P, 12, FontFamily -> "Times"], p, {-2, 0}]};
cir = ParametricPlot3D[circle[t], {t, 0, 2 \[Pi]}, Mesh -> {{\[Pi]}}, 
   MeshShading -> {Directive@{Dashed, Black}, Black}];
dashLines = {Dashed, AbsoluteThickness[2], 
   Line[{{o, p}, {a, b}, {a, c}, {b, c}}]};
realLines = {AbsoluteThickness[2], Line[{{a, p}, {b, p}}]};
boundaryLines = {AbsoluteThickness[2], Line[{{a, p}, {b, p}}]};
Show[Graphics3D[{dashLines, realLines, boundaryLines, labels}], cir, 
 Boxed -> False, Axes -> False, ViewPoint -> {-0.29, -3.26, 0.84}]

Volume[ConvexHullRegion[{a,b,c,o,p}]]It is not possible to determine the volume of the cone using this code. How can I use it to determine the volume of the cone? — csn899, Aug 27 '23 at 11:58
(1) Cone ≠ convex hull of five points. (2) V(cone) = ${1\over3}\pi r^2h$. — Michael E2, Aug 27 '23 at 12:07

score 4 · Answer 3 · answered Aug 27 '23 at 13:31

You are nearly there, your code is nearly o.k. What is missing is, to let MMA know, that you are only interested in real solutions.

Clear["Global`*"];
r = Sqrt[3]; h = 1;
o = {0, 0, 0}; p = {0, 0, h}; \[Alpha] = 180 Degree;
circle[t_] = r {Cos[t], Sin[t], 0};
b = circle[0];
a = circle[0 + \[Alpha]];
c = {x, y, z};
c = SolveValues[{(c - a) . (b - c) == 0, 
    Abs[Cos[VectorAngle[Cross[p - a, p - c], Cross[a - o, a - c]]]] ==
      Cos[45 Degree], z == 0, {x, y, z} \[Element] Reals}, {x, y, 
    z}] // First
labels = {Text[Style[O, 12, FontFamily -> "Times"], o, {2, -1}], 
   Text[Style[A, 12, FontFamily -> "Times"], a, {2, -1}], 
   Text[Style[B, 12, FontFamily -> "Times"], b, {1, 2}], 
   Text[Style[C, 12, FontFamily -> "Times"], c, {-2, 0}], 
   Text[Style[P, 12, FontFamily -> "Times"], p, {-2, 0}]};
cir = ParametricPlot3D[circle[t], {t, 0, 2 \[Pi]}, Mesh -> {{\[Pi]}}, 
   MeshShading -> {Directive@{Dashed, Black}, Black}];
dashLines = {Dashed, AbsoluteThickness[2], 
   Line[{{o, p}, {a, b}, {a, c}, {b, c}}]};
realLines = {AbsoluteThickness[2], Line[{{a, p}, {b, p}}]};
boundaryLines = {AbsoluteThickness[2], Line[{{a, p}, {b, p}}]};
Show[Graphics3D[{dashLines, realLines, boundaryLines, labels}], cir, 
 Boxed -> False, Axes -> False, ViewPoint -> {-0.29, -3.26, 0.84}]

How can drawing this cone always show code running?

3 Answers3