Return to Question

replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/

Source Link

edited Apr 13, 2017 at 12:55

Community Bot

By using Sjoerd de Vries code Sjoerd de Vries code for circular arcs:

Tweeted twitter.com/StackMma/status/758556903421186048

occurred Jul 28, 2016 at 6:57

deleted 63 characters in body

Source Link

edited Jan 17, 2014 at 21:39

Mr.Wizard

275.2k
34
606
1.5k

ClearAll[splineCircle]; splineCircle[m_List, r_, angles_List: {0, 2 \[Pi]π}] := Module[{seg, \[Phi]ϕ, start, end, pts, w, k}, {start, end} = Mod[angles // N, 2 \[Pi]];π]; If[end <= start, end += 2 \[Pi]];π]; seg = Quotient[end - start // N, \[Pi]π/2]; \[Phi]ϕ = Mod[end - start // N, \[Pi]π/2]; If[seg == 4, seg = 3; \[Phi]ϕ = \[Pi]π/2]; pts = r RotationMatrix[start].# & /@ Join[Take[{{1, 0}, {1, 1}, {0, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {0, -1}}, 2 seg + 1], RotationMatrix[seg \[Pi]π/2].# & /@ {{1, Tan[\[Phi]Tan[ϕ/2]}, {Cos[\[Phi]]Cos[ϕ], Sin[\[Phi]]Sin[ϕ]}}]; If[Length[m] == 2, pts = m + # & /@ pts, pts = m + # & /@ Transpose[ Append[Transpose[pts], ConstantArray[0, Length[pts]]]]]; w = Join[ Take[{1, 1/Sqrt[2], 1, 1/Sqrt[2], 1, 1/Sqrt[2], 1}, 2 seg + 1], {Cos[\[Phi]Cos[ϕ/2], 1}]; k = Join[{0, 0, 0}, Riffle[#, #] &@Range[seg + 1], {seg + 1}]; BSplineCurve[pts, SplineDegree -> 2, SplineKnots -> k, SplineWeights -> w]] /; Length[m] == 2 || Length[m] == 3 g1 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, 0, 0}, 1, {0, 3.141592653589}], 1/12], {-1, 1, 1}]}, {1}], Boxed -> False]; g2 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, -1, 0}, 1, {0, 3.141592653589}], 1/12], RotationTransform[Pi, {1, 0, 1}]]}, {1}], Boxed -> False]; g3 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, -1, -2}, 1, {0, 3.141592653589}], 1/12], RotationTransform[Pi, {1, 0, 1}]]}, {1}], Boxed -> False]; g4 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, 0, -2}, 1, {0, 3.141592653589}], 1/12], {-1, 1, 1}]}, {1}], Boxed -> False]; g4 = Show[g1, g2, g3, g4]

ClearAll[splineCircle]; splineCircle[m_List, r_, angles_List: {0, 2 \[Pi]}] := Module[{seg, \[Phi], start, end, pts, w, k}, {start, end} = Mod[angles // N, 2 \[Pi]]; If[end <= start, end += 2 \[Pi]]; seg = Quotient[end - start // N, \[Pi]/2]; \[Phi] = Mod[end - start // N, \[Pi]/2]; If[seg == 4, seg = 3; \[Phi] = \[Pi]/2]; pts = r RotationMatrix[start].# & /@ Join[Take[{{1, 0}, {1, 1}, {0, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {0, -1}}, 2 seg + 1], RotationMatrix[seg \[Pi]/2].# & /@ {{1, Tan[\[Phi]/2]}, {Cos[\[Phi]], Sin[\[Phi]]}}]; If[Length[m] == 2, pts = m + # & /@ pts, pts = m + # & /@ Transpose[ Append[Transpose[pts], ConstantArray[0, Length[pts]]]]]; w = Join[ Take[{1, 1/Sqrt[2], 1, 1/Sqrt[2], 1, 1/Sqrt[2], 1}, 2 seg + 1], {Cos[\[Phi]/2], 1}]; k = Join[{0, 0, 0}, Riffle[#, #] &@Range[seg + 1], {seg + 1}]; BSplineCurve[pts, SplineDegree -> 2, SplineKnots -> k, SplineWeights -> w]] /; Length[m] == 2 || Length[m] == 3 g1 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, 0, 0}, 1, {0, 3.141592653589}], 1/12], {-1, 1, 1}]}, {1}], Boxed -> False]; g2 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, -1, 0}, 1, {0, 3.141592653589}], 1/12], RotationTransform[Pi, {1, 0, 1}]]}, {1}], Boxed -> False]; g3 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, -1, -2}, 1, {0, 3.141592653589}], 1/12], RotationTransform[Pi, {1, 0, 1}]]}, {1}], Boxed -> False]; g4 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, 0, -2}, 1, {0, 3.141592653589}], 1/12], {-1, 1, 1}]}, {1}], Boxed -> False]; g4 = Show[g1, g2, g3, g4]

ClearAll[splineCircle]; splineCircle[m_List, r_, angles_List: {0, 2 π}] := Module[{seg, ϕ, start, end, pts, w, k}, {start, end} = Mod[angles // N, 2 π]; If[end <= start, end += 2 π]; seg = Quotient[end - start // N, π/2]; ϕ = Mod[end - start // N, π/2]; If[seg == 4, seg = 3; ϕ = π/2]; pts = r RotationMatrix[start].# & /@ Join[Take[{{1, 0}, {1, 1}, {0, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {0, -1}}, 2 seg + 1], RotationMatrix[seg π/2].# & /@ {{1, Tan[ϕ/2]}, {Cos[ϕ], Sin[ϕ]}}]; If[Length[m] == 2, pts = m + # & /@ pts, pts = m + # & /@ Transpose[ Append[Transpose[pts], ConstantArray[0, Length[pts]]]]]; w = Join[ Take[{1, 1/Sqrt[2], 1, 1/Sqrt[2], 1, 1/Sqrt[2], 1}, 2 seg + 1], {Cos[ϕ/2], 1}]; k = Join[{0, 0, 0}, Riffle[#, #] &@Range[seg + 1], {seg + 1}]; BSplineCurve[pts, SplineDegree -> 2, SplineKnots -> k, SplineWeights -> w]] /; Length[m] == 2 || Length[m] == 3 g1 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, 0, 0}, 1, {0, 3.141592653589}], 1/12], {-1, 1, 1}]}, {1}], Boxed -> False]; g2 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, -1, 0}, 1, {0, 3.141592653589}], 1/12], RotationTransform[Pi, {1, 0, 1}]]}, {1}], Boxed -> False]; g3 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, -1, -2}, 1, {0, 3.141592653589}], 1/12], RotationTransform[Pi, {1, 0, 1}]]}, {1}], Boxed -> False]; g4 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, 0, -2}, 1, {0, 3.141592653589}], 1/12], {-1, 1, 1}]}, {1}], Boxed -> False]; g4 = Show[g1, g2, g3, g4]

Source Link

asked Jan 17, 2014 at 15:09

Mats Granvik

1.2k
6
20

4 circular arcs, how plot the minimal surface?

By using Sjoerd de Vries code for circular arcs:

ClearAll[splineCircle]; splineCircle[m_List, r_, angles_List: {0, 2 \[Pi]}] := Module[{seg, \[Phi], start, end, pts, w, k}, {start, end} = Mod[angles // N, 2 \[Pi]]; If[end <= start, end += 2 \[Pi]]; seg = Quotient[end - start // N, \[Pi]/2]; \[Phi] = Mod[end - start // N, \[Pi]/2]; If[seg == 4, seg = 3; \[Phi] = \[Pi]/2]; pts = r RotationMatrix[start].# & /@ Join[Take[{{1, 0}, {1, 1}, {0, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {0, -1}}, 2 seg + 1], RotationMatrix[seg \[Pi]/2].# & /@ {{1, Tan[\[Phi]/2]}, {Cos[\[Phi]], Sin[\[Phi]]}}]; If[Length[m] == 2, pts = m + # & /@ pts, pts = m + # & /@ Transpose[ Append[Transpose[pts], ConstantArray[0, Length[pts]]]]]; w = Join[ Take[{1, 1/Sqrt[2], 1, 1/Sqrt[2], 1, 1/Sqrt[2], 1}, 2 seg + 1], {Cos[\[Phi]/2], 1}]; k = Join[{0, 0, 0}, Riffle[#, #] &@Range[seg + 1], {seg + 1}]; BSplineCurve[pts, SplineDegree -> 2, SplineKnots -> k, SplineWeights -> w]] /; Length[m] == 2 || Length[m] == 3 g1 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, 0, 0}, 1, {0, 3.141592653589}], 1/12], {-1, 1, 1}]}, {1}], Boxed -> False]; g2 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, -1, 0}, 1, {0, 3.141592653589}], 1/12], RotationTransform[Pi, {1, 0, 1}]]}, {1}], Boxed -> False]; g3 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, -1, -2}, 1, {0, 3.141592653589}], 1/12], RotationTransform[Pi, {1, 0, 1}]]}, {1}], Boxed -> False]; g4 = Graphics3D[ Table[{[email protected], GeometricTransformation[ Tube[splineCircle[{0, 0, -2}, 1, {0, 3.141592653589}], 1/12], {-1, 1, 1}]}, {1}], Boxed -> False]; g4 = Show[g1, g2, g3, g4]

I plotted these four circular arcs:

bent circle

How can I make a minimal surface that describes both the space inside it, and outside it stretching out to infinity? The minimal surface should describe the object as a whole and not the four arcs individually.

computational-geometry