Fuhrmann Center

Author

Eric W. Weisstein
December 5, 2004

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

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

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

Figure

t=Triangle[{{0,0},{1,0},{.2,.5}}];
Show[Graphics[{
t,
{Green,Circumcircle[t]},
{
Blue,
CircumcircleMidArcTriangle[t]
},
{
Red,
FuhrmannTriangle[t],
FuhrmannCircle[t]
},
{
Purple,
l=Line/@Transpose[Vertices/@Through[{CircumcircleMidArcTriangle,FuhrmannTriangle}[t]]],
MapIndexed[EqualSideTicksAboutMidpoint[#1,#2[[1]],.012,.04]&,l],
PerpSquare[#,.03,.3]&/@Transpose[{Sides[t],l}]
},
{
Orange,
l2=Line[Coordinates/@Through[{NagelPoint,Orthocenter}[t]]],
EqualSideTicksAboutMidpoint[l2,4,.012,.04]
},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Purple]&/@Transpose[{VertexPoints[MedialTriangle[t]],{"(Subscript[M, A])","(Subscript[M, B])","(Subscript[M, C])"}}],
Append[#,Blue]&/@Transpose[{VertexPoints[CircumcircleMidArcTriangle[t]],{"(Subscript[(Overscript[M, ⌢]), A])","(Subscript[(Overscript[M, ⌢]), B])","(Subscript[(Overscript[M, ⌢]), C])"}}],
Append[#,Red]&/@Transpose[{VertexPoints[FuhrmannTriangle[t]],{"(Subscript[F, A])","(Subscript[F, B])","(Subscript[F, C])"}}],
{{Circumcenter[t],"O",Purple},
{FuhrmannCenter[t],"F",Red},
{NagelPoint[t],"Na",Orange},
{Orthocenter[t],"H",Orange}}
],LabelOffset->.03]
}],AspectRatio->Automatic]

Kimberling

X[355]

Midpoint of Na-H

Symmetrize[Factor[ToSidelengths[Midpoint[{NagelPoint,Orthocenter}]][[1]]]]

CenterFunction[FuhrmannCenter]

Symmetrize[Simplify[Together//@ToSidelengths[TrigExpand[%]],TriangleQ[]]]

Structures Passing through It

pt=FuhrmannCenter;

Circles

First/@Select[{#,IncidentCenters[{pt},#]}&/@Circles,Last[#]=!={}&]

Circle Centers

First/@Select[{#,IncidentCenters[{pt},CircleCenter[#]]}&/@Circles,Last[#]=!={}&]

Conics

First/@Select[{#,IncidentCenters[{pt},#]}&/@Conics,Last[#]=!={}&]

Cubics

First/@Select[{#,IncidentCenters[{pt},#]}&/@TriangleCubics,Last[#]=!={}&]

Lines

First/@Select[{#,IncidentCenters[{pt},#]}&/@Lines,Last[#]=!={}&]