Create a regular polygon with n vertices given two points

Question

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

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.

Answer 1

• 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]

{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}]}]

{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}]]

• 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]]}]

• 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}]}]]

• 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]]

Answer 2

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}]}]
 ]

Answer 3

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]

Answer 4

I will recommend ResourceFunction["PolygonFromBase"] here:

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

Answer 5

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}}]