8
$\begingroup$

I want to create a regular polygon from the initial two points $A$, $B$ and number of vertices $n$,
enter image description here

regularPolygon[{0, 0}, {1, 0}, 3] gives {{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}

regularPolygon[{x1, y1}, {x2, y2}, 4] gives {{x1, y1}, {x2, y2}, {x2 + y1 - y2, -x1 + x2 + y2}, {x1 + y1 - y2, -x1 + x2 + y1}}

I found a related function CirclePoints, it seems not suitable. Is there a simple way to implement such a function? Maybe you can use iteration.

$\endgroup$
0

5 Answers 5

12
$\begingroup$
  • AnglePath.

For two point {x1,y1} and {x2,y2}, at first we locate at {x2,y2} and toward to the direction {x2,y2}-{x1,y2}, then turn to a new direction by rotate a angle2 Pi/n, after n rotation we go back to {x2,y2}.

{dx, dy} = {x2, y2} - {x1, y1};
length = Sqrt[{dx, dy} . {dx, dy}];
n = 4;
pts = AnglePath[{{x2, y2}, {dx, dy}}, 
   ConstantArray[{length, 2 Pi/n}, n]] // FullSimplify
RotateRight[Most@pts]

enter image description here

{dx, dy} = {x2, y2} - {x1, y1};
length = Sqrt[{dx, dy} . {dx, dy}];
n = 5;
pts = AnglePath[{{x2, y2}, {dx, dy}}, 
   ConstantArray[{length, 2 Pi/n}, n]];
poly = Polygon[pts];
{x1, y1} = {2, 2};
{x2, y2} = {5, 5};
Graphics[{EdgeForm[Black], FaceForm[], poly, AbsolutePointSize[10], 
  Red, Point[{{x1, y1}}], Text[{x1, y1}, {x1, y1}, {0, 2}], Blue, 
  Point[{{x2, y2}}], Text[{x2, y2}, {x2, y2}, {-2, 0}]}]

enter image description here

{x1, y1} = {2, 2};
{x2, y2} = {5, 5};
{dx, dy} = {x2, y2} - {x1, y1};
length = Norm[{dx, dy}];
Graphics[
 Table[{EdgeForm[RandomColor[]], FaceForm[], 
   Polygon[AnglePath[{{x2, y2}, {dx, dy}}, 
     ConstantArray[{length, 2 π/n}, n]]]}, {n, 3, 8}]]

enter image description here

  • NestList + RotationMatrix.
p[1] = {x1, y1} =N@{2, 2};
p[2] = {x2, y2} =N@{5, 5};
n = 5;
θ = (2 π)/n;
lines = NestList[{#[[2]], #[[2]] + 
      RotationMatrix[θ] . (#[[2]] - #[[1]])} &, {p[1], p[2]}, 
   n];
poly = Polygon[lines[[;; , 2]]];
Graphics[{EdgeForm[Blue], FaceForm[], poly, Arrow@lines, 
  AbsolutePointSize[10], Red, Point[p[1]], Blue, Point[p[2]]}]

enter image description here

  • Using complex number to rotate the vector.
Clear["Global`*"];
z[1] = {x1, y1} . {1, I};
z[2] = {x2, y2} . {1, I};
n = 5;
θ = (2 π)/n;
ω = Exp[I*θ];
z[k_] := z[k] = z[k - 1] + (z[k - 1] - z[k - 2]) ω;
Table[z[k], {k, n}] // ReIm // ComplexExpand
Block[{x1, y1, x2, y2},
 {x1, y1} = {2, 2};
 {x2, y2} = {5, 5};
 Graphics[{RegionBoundary@Polygon[pts], AbsolutePointSize[10], Red, 
   Point[{x1, y1}], Blue, Point[{x2, y2}]}]]

enter image description here

  • FoldList +AngleVector
n = 5;
{dx, dy} = {x2 - x1, y2 - y1};
length = Sqrt[{dx, dy} . {dx, dy}];
pts = FoldList[AngleVector, {x2, y2}, 
   Table[{length, ArcTan[dx, dy] + k (2 π)/n}, {k, n}]] // 
  FullSimplify
{x1, y1} = {2, 2};
{x2, y2} = {5, 5};
Graphics[Polygon[pts]]

enter image description here

$\endgroup$
10
$\begingroup$

You can use CirclePoints. You just need to transform them:

{x1, y1} = {3, 6};
{x2, y2} = {-4, 2};
circ = N@CirclePoints[5];
tran = Last@FindGeometricTransform[{{x1, y1}, {x2, y2}}, circ[[;;2]]];
With[{tcirc = tran[circ]},
 ListLinePlot[Append[tcirc, First@tcirc], AspectRatio -> 1, 
  Epilog -> {Red, PointSize[Large], Point[{x1, y1}], 
    Point[{x2, y2}]}]
 ]

circle points

$\endgroup$
6
$\begingroup$

Corroborating cvgm interesting work, we may improve a bit. {x1,y1} is not on the polygon and the winding direction is opposite to the positive mathematical winding direction. This may be fixed by:

{x1, y1} = {2, 3};
{x2, y2} = {5, 5};
length = Norm[{x2, y2} - {x1, y1}];
n = 5;
Graphics[{Polygon[
   AnglePath[{{x2, y2}, {x2, y2} - {x1, y1}}, 
    ConstantArray[{length, 2 Pi/n}, n]]], 
  Text["Point 1", {x1, y1 - 0.3}], Text["Point 2", {x2, y2 - 0.3}], 
  PointSize[0.02], Red, Point[{{x1, y1}, {x2, y2}}]}, Axes -> True]

enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ Yes, I just found my mistake when I test my code in computer,before that I only have wolfram cloud in mobile, it is not so easy to use. $\endgroup$
    – cvgmt
    Jan 29, 2023 at 13:21
  • 1
    $\begingroup$ No problem, happens to all of us. $\endgroup$ Jan 29, 2023 at 13:27
6
$\begingroup$

I will recommend ResourceFunction["PolygonFromBase"] here:

base = {{0, 1}, {2, 3}};
Graphics[{Line[base], Table[{RandomColor[], 
    Line[ResourceFunction["PolygonFromBase"][base, i]]}, {i, 3, 10}]}]

enter image description here

$\endgroup$
2
$\begingroup$

For variety's sake, we can also use the given inputs to construct the circumradius, circumcenter and starting angle and use these with the three-argument form of RegularPolygon:

ClearAll[regularPoly]

regularPoly[p1_, p2_, n_] := 
 Module[{startingangle = Pi/n - Pi/2 + ArcTan @@ (p2 - p1),
   circumradius = Norm[p2 - p1]/2/Sin[Pi/n], circumcenter}, 
  circumcenter = p2 - circumradius Through@{Cos, Sin}@startingangle;
  RegularPolygon[circumcenter, {circumradius, startingangle}, n]]

Examples:

{p1, p2} = {{2, 2}, {5, 5}};

Graphics[{FaceForm[], 
  Table[{EdgeForm@RandomColor[], regularPoly[p1, p2, j]}, {j, 3, 9}], 
  AbsoluteThickness@5, Red, CapForm["Round"], Line@{p1, p2}, 
  AbsolutePointSize@25, Point@{p1, p2}, White, 
  MapIndexed[Text[Subscript[p, #2[[1]]], #] &] @ {p1, p2}}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.