Advertisement
Matthen

Folding an ellipse

Nov 27th, 2012
481
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.43 KB | None | 0 0
  1. p = RandomReal[{0.2, 0.9}] (({Sin[#], Cos[#]} &)[RandomReal[]]);
  2. R = RotationMatrix[Pi/2];
  3. n = 33;
  4. p2s = Table[{Sin[\[Theta]], Cos[\[Theta]]}, {\[Theta], 0, 2 Pi,
  5. 2 Pi/n}];
  6. ns = Table[R.(p1 - p)/Norm[p1 - p], {p1, p2s}];
  7. frame[i_] := Block[{p1, n1, m, n2},
  8. n1 = ns[[Mod[i, n, 1]]];
  9. p1 = p2s[[Mod[i, n, 1]]];
  10. n2 = (p - p1)/Norm[p - p1];
  11. n1 = n1/Norm[n1];
  12. m = (p1 + p)/2;
  13. Graphics[
  14. {
  15. {
  16. Thick,
  17. RGBColor[0.1, 0.1, 0.3],
  18. Circle[{0, 0}, 1]
  19. },
  20. If[i > n,
  21. If[i > 2 n,
  22. Table[
  23. Block[{pt, nt},
  24. pt = p2s[[j]]; nt = ns[[j]];
  25. {
  26. Line[{(pt + p)/2 + 10 nt, (pt + p)/2 - 10 nt}]
  27. }
  28. ]
  29. , {j, i - 2 n, n}]
  30. ,
  31. Table[
  32. Block[{pt, nt},
  33. pt = p2s[[j]]; nt = ns[[j]];
  34. {
  35. Line[{(pt + p)/2 + 10 nt, (pt + p)/2 - 10 nt}]
  36. }
  37. ]
  38. , {j, i - n}]
  39. ]
  40. ,
  41. {}
  42. ],
  43. Thick,
  44. PointSize[Large],
  45. Point[p1],
  46. Point[p],
  47. RGBColor[0.3, 0.1, 0.1],
  48. Line[{p1, p}],
  49. RGBColor[0.5, 0.1, 0.07],
  50. Line[{m + 10 n1, m - 10 n1}],
  51. FaceForm[],
  52. EdgeForm[Black],
  53. Polygon[{
  54. m + 0.1 n2 + 0.1 n1,
  55. m - 0.1 n2 + 0.1 n1,
  56. m - 0.1 n2 - 0.1 n1,
  57. m + 0.1 n2 - 0.1 n1
  58. }]
  59. }
  60. , ImageSize -> 300, PlotRange -> 1.5]
  61. ];
  62. Manipulate[
  63. frame[i]
  64. , {i, 1, 3 n, 1}]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement