Napoleonpunkte

source  =  
        DirectoryName[
          ToFileName["FileName" /. 
              NotebookInformation[EvaluationNotebook[]]]];
SetDirectory[source];
Needs["GeoBeweiser`"]

clearndg[];
Clear[u1, u2, u3, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, 
        x13, x14, y];

vars := {x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, 
          y};
parameters := {u1, u2, u3};

\(\(\( (*Punkte\ definieren*) \)\(
\)\(\(Unprotect[
        C];\)

    A = point[0, 0]; B = point[u1, 0];

    \(C = point[u2, u3];\)

    As = point[x1, x2]; Bs = point[x3, x4]; 
    Cs = point[x5, x6];

    X = point[x7, x8]; Y = point[x9, x10]; 
    Z = point[x11, x12];

    \(Napoleon = point[x13, x14];\)\)\)\)

Napoleon = 
        intersectionpoint[ppline[X, A], ppline[Y, B]];

AddGleichung[
      As - rotate[C, B, 1/3]]

AddGleichung[Bs - rotate[A, C, 1/3]]

AddGleichung[Cs - rotate[B, A, 1/3]]

AddGleichung[
      centroid[As, B, C] - X]

AddGleichung[centroid[A, Bs, C] - Y]

AddGleichung[centroid[A, B, Cs] - Z]

polys=Map[Numerator[Together[#]] &, Gleichungen]

con = Numerator[online[Napoleon, ppline[Z, C]]]

IdealMember[con, polys, vars] // Timing

Das Schwerpunktedreieck ist gleichseitig:

con1 = Numerator[sqrdist[X, Y] - sqrdist[Y, Z]]

con2 = Numerator[sqrdist[X, Z] - sqrdist[Y, Z]]

IdealMember[con1, polys, vars] // Timing

IdealMember[con2, polys, vars] // Timing

Beweis der Bemerkung: Der Napoleonpunkt liegt auf der Eulergeraden.

Schwerpunkt = centroid[A, B, C]

Umkreismittelpunkt = circumcenter[A, B, C]

con3 = 
      online[Napoleon, ppline[Schwerpunkt, Umkreismittelpunkt]]

IdealMember[con3, polys, vars] // Timing