Similitude Center

Author

Eric W. Weisstein
January 5, 2003

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

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

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

Initialization

<<PlaneGeometry`

Figure

t1=Triangle[{{0,0},{.7,.5},{1,0}}];
α=110Degree;
t2=t1/.Triangle[l_]:>Triangle[{.2,.9}+{{Cos[α],Sin[α]},{-Sin[α],Cos[α]}}.(.4#)&/@l];
t={t1,t2};
p=Coordinates[Intersections@@#]&/@Transpose[Sides/@t];
v=Vertices/@t;
lines=Transpose[Map[Line,Partition[#,2,1,1]&/@v,{2}]];
i=Intersections@@@lines;
pts=Transpose[Append[Map[Point,v,{2}],i]];
circs=Circumcircle/@Triangle/@Map[Coordinates,pts,{2}];
sim=Intersection[Sequence@@Intersections@@@Partition[circs,2,1],
SameTest->(#.#&[Abs[Coordinates[#1]-Coordinates[#2]]]<10^-6&)][[1]];
Show[Graphics[{
PointSize[.018],
Point/@p,
MapIndexed[{{Red,Green,Blue}[[#2[[1]]]],#1}&,
Transpose[{lines,circs,pts}]/.Line[l_]:>LongestLine[l,2]],
t,
PointLabels[Transpose[{Point/@v1,{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[A, 3])"}}],{PointSize[.01]}],
PointLabels[Transpose[{Point/@v2,{"(Subscript[B, 1])","(Subscript[B, 2])","(Subscript[B, 3])"}}],{PointSize[.01],LabelOffset->{-.1,.05}}],
PointLabels[{{sim,"S"}},{DarkOrange,PointSize[.015]}]
},AspectRatio->Automatic]]