Exeterpunkt

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, x15, x16, x17, x18, y];

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

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

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

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

    A1 = point[x1, x2]; B1 = point[x3, x4]; 
    C1 = point[x5, x6];

    A2 = point[x7, x8]; B2 = point[x9, x10]; 
    C2 = point[x11, x12];

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

kUmkreis = 
        p3circle[A, B, C];

    MUmkreis = circlecenter[kUmkreis];

    S = 
        intersectionpoint[ppline[C, midpoint[A, B]], 
          ppline[A, midpoint[B, C]]];

A2 = 
      otherclpoint[A, kUmkreis, ppline[A, S]]

B2 = otherclpoint[B, kUmkreis, ppline[B, S]]

C2 = otherclpoint[C, kUmkreis, ppline[C, S]]

at = 
      ortholine[A, ppline[A, MUmkreis]]

bt = ortholine[B, ppline[B, MUmkreis]]

ct = ortholine[C, ppline[C, MUmkreis]]

A1 = 
      intersectionpoint[bt, ct]

B1 = intersectionpoint[at, ct]

C1 = intersectionpoint[bt, at]

AddGleichung[
      intersectionpoint[ppline[B1, B2], ppline[A1, A2]] - 
        Exeter]

(* polynomials *)
polys=Map[Numerator[Together[#]] &, Gleichungen]

con =  
      online[Exeter, ppline[C1, C2]]

IdealMember[con, polys, vars] // Timing

Beweis der Bemerkung: Der Exeterpunkt liegt auf der Eulergeraden.

Schwerpunkt = centroid[A, B, C]

Umkreismittelpunkt = circumcenter[A, B, C]

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

IdealMember[con3, polys, vars] // Timing