用Wolfram Mathematica 畫連桿機構

On 由predliu撰寫In Mathematica

用Wolfram Mathematica 畫一下幾何圖（還可以動態） ,蠻快就做好了。因為不用設定很多細節。

mathematica程式碼,分享如下
circle[d_, r_, n_] := Block[{a, b, i, y1, xList},
  circlePoint = {d*(# - 1), 0} & /@ Range[n];
  y1 = Sqrt[r^2 - (d/2)^2];
  xList = Table[{(d*(1/2 + i - 1)), y1*(-1)^i}, {i, 1, n - 1}];
  cutePoint$list = {{{0, 0}}, xList, {{(n - 1) d, 0}}} // 
    Flatten[#, 1] &;
  
  lineN = Line[cutePoint$list];
  lineP = lineN /. {a_, b_} -> {a, -b};
  
  Circle[#, r] & /@ circlePoint // Flatten
  ]


Manipulate[
 r = 5; n = 6; cc = circle[a, r, n];
 circleJoin = 
  Graphics[{Opacity[0.5], Dashed, circle[a, r, n], 
    Line[{{-1 - r, 0}, {2 r*n, 0}}], Line[{{0, -r}, {0, r}}]}];
 link = {Thick, Red, lineP, lineN} // Graphics;
 Show[{link, circleJoin}],
 {{a, 5, "Distance"}, 1, 2 r}, ControlPlacement -> Top
 ]

發表留言