公告:本站正式转型为非交互式静态网站!
转型:本站将通过笔记和博客的形式继续为大家服务,关于 Mathematica 问答服务请移步至QQ群:365716997
联系:如有问题请联系QQ群管理员,或发送邮件至:lixuan.xyz@qq.com。
感谢:最后非常感谢大家多年来的支持与帮助!
参考《互联网跟帖评论服务管理规定》《中华人民共和国网络安全法》《网络信息内容生态治理规定》《互联网用户账号信息管理规定》

—— 2022-11-27

欢迎来到 Mathematica 问答社区

提问时请贴上文本代码

语法高亮:在编辑器中点击

被禁止的话题:广告破解

请阅读:《提问的智慧》

备用域名:mma.ooo

支持LaTex数学公式
行内公式标识符:\$ 或“$\backslash ($”+“$\backslash )$”,
行间公式标识符:\$\$ 或 “$\backslash [$”+“$\backslash ]$”

社区建议QQ群:365716997

分类

0 投票
1.1k 浏览

做了一个圆锥的展开示意图,想表达圆锥的侧面展开时,展开的扇形平面(目前是线条)可以随着旋转角度变化而变化

原代码如下:
 

Manipulate[
 l = Sqrt[r^2 + h^2]; \[Alpha] = (2 Pi r)/l; \[Beta] = 
  Pi/2 - ArcTan[r/h]; \[Delta] = \[Gamma]/(2 Pi)*\[Alpha];
 a = Graphics3D[{Opacity[.3], Cone[{{0, -h, 0}, {0, 0, 0}}, r]}, 
   Boxed -> False, PlotRange -> {{-4, 4}, {-4, 4}, {-3, 3}}, 
   PlotLabel -> 
    Column[{{"底面积:\!\(\*SuperscriptBox[\(\[Pi]r\), \(2\)]\)="} <> 
       "2\[CapitalPi]*" <> ToString[r^2] <> "=" <> 
       ToString[
        N[Pi*r^2., 
         4]], {"侧面展开扇形面积:\[CapitalPi]rL=\[CapitalPi]r\!\(\*SqrtBox[\
\(\*SuperscriptBox[\(r\), \(2\)] + \*SuperscriptBox[\(h\), \
\(2\)]\)]\)="} <> "\[Pi]*" <> ToString[r] <> "*" <> 
       ToString[Sqrt[r^2 + h^2]] <> "=" <> ToString[N[Pi r l]]}], 
   ImageSize -> {420, 400}, ViewPoint -> {0, -2.4, 2.2}];
 b = Graphics3D[{{Blue, PointSize[.02], Point[{{r, -h, 0}}]}, {Red, 
     Dashed, Line[{{0, -h, 0}, {0, 0, 0}}]}, {Green, Dashed, 
     Line[{{0, -h, 0}, {r, -h, 0}}]}, {Red, Thickness[.005], Dashed, 
     Line[{{r, -h, 0}, {0, 0, 0}}]}, {Opacity[.4], Green, 
     Polygon[{{0, 0, 0}, {0, -h, 0}, {r, -h, 0}}]}}];
 c = Graphics3D[{Red, Thickness[.005], 
    Line[{{l Cos[\[Delta] - \[Beta]], l Sin[\[Delta] - \[Beta]], 
       0}, {0, 0, 0}}]}];
 d = Graphics3D[
   GeometricTransformation[b[[1]], 
    RotationTransform[\[Gamma], {0, 1, 0}]]];
 e = ParametricPlot3D[{l Cos[t], l Sin[t], 
    0}, {t, -\[Beta] + 0.0001, \[Delta] - \[Beta]}, 
   PlotStyle -> {Red}];
 f = Graphics3D[
   GeometricTransformation[a[[1]], 
      ScalingTransform[10^-3, {0, -.5, 0}, #]] & /@ {{0, k, 0}}];
 Show[a, b, c, d, e, f], {{r, 1, "底面半径r"}, 0.1, 1.5, 
  ImageSize -> Small}, {{h, 2, "圆锥的高h"}, 0.5, 2.5, 
  ImageSize -> Small}, {{\[Gamma], 0.0001, "旋转的角\[Gamma]"}, 0.0001, 
  2 Pi, ImageSize -> Small}, {{k, -h - 0.2, "底面距离k"}, -h, -h - 1, 
  ImageSize -> Small}, ControlPlacement -> {Left, Left, Left, Left}, 
 ContentSize -> {450, 420}, SaveDefinitions -> True]

 

分类:绘图 | 用户: yangjianxing (31 分)
修改于 用户:野鹤
社区支持语法高亮,在提问粘贴代码时,在编辑器中点击最后一个按钮:“<>”

1个回答

+1 投票

用 Polygon 吧,比如把 e 改成(最后的 0.01 是步长):

e = Graphics3D[
  Polygon[{{0, 0, 0}}~Join~
    Table[{l Cos[t], l Sin[t], 
      0}, {t, -\[Beta] + 0.0001, \[Delta] - \[Beta], 0.01}]]]

完整的代码:

Manipulate[
 l = Sqrt[r^2 + h^2]; \[Alpha] = (2 Pi r)/l; \[Beta] = 
  Pi/2 - ArcTan[r/h]; \[Delta] = \[Gamma]/(2 Pi)*\[Alpha];
 a = Graphics3D[{Opacity[.3], Cone[{{0, -h, 0}, {0, 0, 0}}, r]}, 
   Boxed -> False, PlotRange -> {{-4, 4}, {-4, 4}, {-3, 3}}, 
   PlotLabel -> 
    Column[{{"底面积:\!\(\*SuperscriptBox[\(\[Pi]r\), \(2\)]\)="} <> 
       "2\[CapitalPi]*" <> ToString[r^2] <> "=" <> 
       ToString[
        N[Pi*r^2., 
         4]], {"侧面展开扇形面积:\[CapitalPi]rL=\[CapitalPi]r\!\(\*SqrtBox[\
\(\*SuperscriptBox[\(r\), \(2\)] + \*SuperscriptBox[\(h\), \
\(2\)]\)]\)="} <> "\[Pi]*" <> ToString[r] <> "*" <> 
       ToString[Sqrt[r^2 + h^2]] <> "=" <> ToString[N[Pi r l]]}], 
   ImageSize -> {420, 400}, ViewPoint -> {0, -2.4, 2.2}];
 b = Graphics3D[{{Blue, PointSize[.02], Point[{{r, -h, 0}}]}, {Red, 
     Dashed, Line[{{0, -h, 0}, {0, 0, 0}}]}, {Green, Dashed, 
     Line[{{0, -h, 0}, {r, -h, 0}}]}, {Red, Thickness[.005], Dashed, 
     Line[{{r, -h, 0}, {0, 0, 0}}]}, {Opacity[.4], Green, 
     Polygon[{{0, 0, 0}, {0, -h, 0}, {r, -h, 0}}]}}];
 c = Graphics3D[{Red, Thickness[.005], 
    Line[{{l Cos[\[Delta] - \[Beta]], l Sin[\[Delta] - \[Beta]], 
       0}, {0, 0, 0}}]}];
 d = Graphics3D[
   GeometricTransformation[b[[1]], 
    RotationTransform[\[Gamma], {0, 1, 0}]]];
 e = Graphics3D[
   Polygon[{{0, 0, 0}}~Join~
     Table[{l Cos[t], l Sin[t], 
       0}, {t, -\[Beta] + 0.0001, \[Delta] - \[Beta], 0.01}]]];
 f = Graphics3D[
   GeometricTransformation[a[[1]], 
      ScalingTransform[10^-3, {0, -.5, 0}, #]] & /@ {{0, k, 0}}];
 Show[a, b, c, d, e, f],
 {{r, 1, "底面半径r"}, 0.1, 1.5, ImageSize -> Small}, {{h, 2, "圆锥的高h"}, 
  0.5, 2.5, ImageSize -> Small}, {{\[Gamma], 0.0001, "旋转的角\[Gamma]"}, 
  0.0001, 2 Pi, 
  ImageSize -> Small}, {{k, -h - 0.2, "底面距离k"}, -h, -h - 1, 
  ImageSize -> Small}, ControlPlacement -> {Left, Left, Left, Left}, 
 ContentSize -> {450, 420}, SaveDefinitions -> True]

 

用户: 野鹤 (5.1k 分)
...