# Create a regular polygon with n vertices given two points

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.

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


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


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]


• 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. Commented Jan 29, 2023 at 13:21
• No problem, happens to all of us. Commented Jan 29, 2023 at 13:27

I will recommend ResourceFunction["PolygonFromBase"] here:

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


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;

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