Perpendicular Bisector

Author

Eric W. Weisstein
October 8, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/PerpendicularBisector.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/PerpendicularBisector.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Usage

?PerpendicularBisector

?PerpendicularBisectors

Perpendicular Bisector of a Line Segment

r=.2;
ps=.045;
h=Sqrt[r(r+2)];
l=Line[{{0,0},{2,0}}];
p=PerpendicularBisector[l,h];
pts={
{"A",BeginPoint[l]},
{"B",EndPoint[l]},
{"M",Midpoint[l]},
{"C",BeginPoint[p]},
{"D",EndPoint[p]}
};
p2=PerpendicularBisector[l,Sqrt[3]];
pts2={
{"A",BeginPoint[l]},
{"B",EndPoint[l]},
{"M",Midpoint[l]},
{"C",BeginPoint[p2]},
{"D",EndPoint[p2]}
};
range={{-.2,2.1},{-(h+.2),(h+.2)}};
Show[GraphicsArray[{
Graphics[g={
p,
PointSize[ps],
{Red,
l,
Point/@Coordinates[l],
Midpoint[l]
},
Point/@Coordinates[p],
PerpSquare[{l,p},.065,2],
Text[#1,#2/.Point[x_]:>x-.09,TextStyle->{FontFamily->"Times",FontSlant->"Italic"}]&@@@pts
},AspectRatio->Automatic,PlotRange->range],
Graphics[{{Red,l},
Text[#1,#2/.Point[x_]:>x-.25,TextStyle->{FontFamily->"Times",FontSlant->"Italic"}]&@@@pts2,
{Blue,
Circle[{0,0},2],
Circle[{2,0},2]
},
PointSize[ps],
Line[{{1,-Sqrt[3]},{1,Sqrt[3]}}],
{Red,Point/@Coordinates[l],Point[{1,0}]},
Point/@{{1,-Sqrt[3]},{1,Sqrt[3]}}
},AspectRatio->Automatic],
Graphics[{p,g,
Circle[{0,0},1+r,(ArcSec[1+r]+.2){-1,1}],
Circle[{2,0},1+r,Pi+(ArcSec[1+r]+.2){-1,1}],
{
Blue,
PointSize[ps],
Circle[{1,0},r],
Point/@{{1+r,0},{1-r,0}}
}
},AspectRatio->Automatic,PlotRange->range]}
]]

Perpendicular Bisectors of a Triangle

t=Triangle[{{0.,-.5},{3.,-.4},{1.3,1.7}}];
Show[Graphics[{
t,
EqualSideTicksAboutMidpoints[t,.05,.02],
{Green,Circumcircle[t]},
{Red,bis=PerpendicularBisectors[t],
PerpSquare[{#,PerpendicularLine[Circumcenter[t],#]},.1,2]&/@Sides[t]
},
{Blue,
Line[{Coordinates@Circumcenter[t],#}]&/@Vertices[t],
EqualSideTicks[{Coordinates@Circumcenter[t],#},4,.05]&/@Vertices[t]
},
PointLabels[Join[
{{Circumcenter[t],"O",Blue}},
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Red]&/@Transpose[{Midpoints[t],{"(Subscript[M, A])","(Subscript[M, B])","(Subscript[M, C])"}}]
],
LabelOffset->.1,PointSize[.025]]
}],AspectRatio->Automatic,PlotRange->All]