Proyectivas3.nb is used

Versions of n - Lines

3 - Line

S31={2,2,1};S12={9,2,1};S23={4,8,1};n4Gon={S31,S12,S23};
L1=Recta[S31,S12];L2=Recta[S12,S23];L3=Recta[S23,S31];n3Lines={L1,L2,L3};

4 - Line

S41={2,2,1};S12={9,2,1};S23={7,6,1};S34={4,8,1};n4Gon={S41,S12,S23,S34,S41};
L1=Recta[S41,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S41];n4Lines={L1,L2,L3,L4};

5 - Line

S51={6,2,1};S12={11,2,1};S23={12,4,1};S34={8,8,1};S45={5,5,1};n5Gon={S51,S12,S23,S34,S45,S51};
L1=Recta[S51,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S51];n5Lines={L1,L2,L3,L4,L5};

6 - Line

S61={7,6,1};S12={13,6,1};S23={15,9,1};S34={14,12,1};S45={9,15,1};S56={5,10,1};n6Gon={S61,S12,S23,S34,S45,S56,S61};
L1=Recta[S61,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S56];L6=Recta[S56,S61];
n6Lines={L1,L2,L3,L4,L5,L6};

7 - Line

S71={7.05,6,1};S12={13,6,1};S23={15.5,9,1};S34={14,12,1};S45={10,14,1};S56={7,11.5,1};S67={6.05,9,1};n7Gon={S71,S12,S23,S34,S45,S56,S67,S71};
L1=Recta[S71,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S56];L6=Recta[S56,S67];L7=Recta[S67,S71];
n7Lines={L1,L2,L3,L4,L5,L6,L7};

8 - Line

S81={5,3,1};S12={12,3,1};S23={14,5,1};S34={15,8,1};S45={13,11,1};S56={9,13,1};S67={3,10,1};S78={2,6,1};n8Gon={S81,S12,S23,S34,S45,S56,S67,S78,S81};
L1=Recta[S81,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S56];L6=Recta[S56,S67];L7=Recta[S67,S78];L8=Recta[S78,S81];n8Lines={L1,L2,L3,L4,L5,L6,L7,L8};

9 - Line

S91={4,2,1};S12={9,2,1};S23={11,3,1};S34={12,8,1};S45={11,10,1};S56={7,11,1};S67={4,9.7,1};S78={1,7,1};S89={2,4,1};n9Gon={S91,S12,S23,S34,S45,S56,S67,S78,S89,S91};
L1=Recta[S91,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S56];L6=Recta[S56,S67];L7=Recta[S67,S78];L8=Recta[S78,S89];L9=Recta[S89,S91];n9Lines={L1,L2,L3,L4,L5,L6,L7,L8,L9};
xmin=-15;xmax=30;ymin=-15;ymax=30;

10 - Line

S01={4,2,1};S12={9,2,1};S23={11,3,1};S34={12,8,1};S45={11,10,1};S56={7,11,1};S67={4,9.7,1};S78={1,7,1};S89={2,4,1};S90={3,2.5,1};n10Gon={S01,S12,S23,S34,S45,S56,S67,S78,S89,S90,S01};
L1=Recta[S01,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S56];L6=Recta[S56,S67];L7=Recta[S67,S78];L8=Recta[S78,S89];L9=Recta[S89,S90];L0=Recta[S90,S01];n10Lines={L1,L2,L3,L4,L5,L6,L7,L8,L9,L0};
xmin=-15;xmax=30;ymin=-15;ymax=30;

Recursive nL - Point functions

Preliminary functions

C3is1[XX_]:=Module[{limit,YY},limit=10^(-19);YY={0,0,0};If[Abs[XX[[3]]]!=0,YY=XX/XX[[3]],If[Abs[XX[[1]]]!=0,YY=XX/XX[[1]],If[Abs[XX[[2]]]!=0,YY=XX/XX[[2]],Print["To many zeroes: ",XX]]]];YY]
PCentroid[list_]:=Module[{n,T},n=Length[list];T=Total[Map[CartesianPoint,list]]/n;Append[T,1]]
SumVectorPoint[O_,list_]:=Module[{n,T},n=Length[list];T=Total[list]-(n-1)O;T/T[[3]]]

Points in a 3-Line

L3X2[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[Baricentro[{P1,P2,P3}]]]   (* L3-Centroid *)
L3X3[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[Circuncentro[{P1,P2,P3}]]]   (* L3-Circumcenter *)
L3X4[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[Ortocentro[{P1,P2,P3}]]]   (* L3-Orthocenter *)
L3X5[nLines_]:=Medio[L3X3[nLines],L3X4[nLines]]   (* L3-Nine-point Center *)
L3X186[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[InversoCircunscrita[L3X4[nLines],{P1,P2,P3}]]]   (* L3-X186 *)
L3X265[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[ConjugadoIsogonal[L3X186[nLines],{P1,P2,P3}]]]   (* L3-X265 *)
L3X5961[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[InversoCircunscrita[L3X265[nLines],{P1,P2,P3}]]]   (* L3-X5961 *)
L3X5962[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[ConjugadoIsogonal[L3X5961[nLines],{P1,P2,P3}]]]   (* L3-X5962 *)
L3X5963[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[InversoCircunscrita[L3X5962[nLines],{P1,P2,P3}]]]   (* L3-X5963 *)
L3X5964[nLines_]:=Module[{P1,P2,P3},P1=Cross[nLines[[2]],nLines[[3]]];P2=Cross[nLines[[3]],nLines[[1]]];P3=Cross[nLines[[1]],nLines[[2]]];C3is1[ConjugadoIsogonal[L3X5963[nLines],{P1,P2,P3}]]]   (* L3-X5964 *)

Points in a 4-Line

L4DT[{L1_,L2_,L3_,L4_}]:=Module[{P12,P13,P14,P23,P24,P34,L1234,L1324,L1423},P12=Punto[L1,L2];P34=Punto[L3,L4];L1234=Recta[P12,P34];P13=Punto[L1,L3];P24=Punto[L2,L4];L1324=Recta[P13,P24];P14=Punto[L1,L4];P23=Punto[L2,L3];L1423=Recta[P14,P23];{C3is1[L1234],C3is1[L1324],C3is1[L1423]}]
L4QLL1[L4Ref_]:=Recta[Medio[Punto[L4Ref[[1]],L4Ref[[2]]],Punto[L4Ref[[3]],L4Ref[[4]]]],Medio[Punto[L4Ref[[1]],L4Ref[[3]]],Punto[L4Ref[[2]],L4Ref[[4]]]]]
L4QLL2[L4Ref_]:=Recta[L3X4[Delete[L4Ref,1]],L3X4[Delete[L4Ref,2]]]
L4QLP1[L4Ref_]:=nP1[L4Ref]
L4QLP2[L4Ref_]:=nP10[L4Ref]
L4QLP3[L4Ref_]:=nP7[L4Ref]
L4QLP4[L4Ref_]:=Circuncentro[{L3X3[Delete[L4Ref,1]],L3X3[Delete[L4Ref,2]],L3X3[Delete[L4Ref,3]]}]
L4QLP5[L4Ref_]:=C3is1[Medio[L4QLP3[L4Ref],L4QLP4[L4Ref]]]
L4QLP6[L4Ref_]:=C3is1[Medio[L4QLP5[L4Ref],L4QLP4[L4Ref]]]
L4QLP7[L4Ref_]:=C3is1[Punto[L4QLL1[L4Ref],L4QLL2[L4Ref]]]
L4QLP8[L4Ref_]:=C3is1[L3X2[L4DT[L4Ref]]]
L4QLP9[L4Ref_]:=C3is1[L3X3[L4DT[L4Ref]]]
L4QLP10[L4Ref_]:=C3is1[L3X4[L4DT[L4Ref]]]
L4QLP11[L4Ref_]:=C3is1[L3X5[L4DT[L4Ref]]]
L4QLP12[L4Ref_]:=nP8[L4Ref]
L4QLP13[L4Ref_]:=Module[{M12,M13,M14,S2,S3,S4,T2,T3,T4,L12,L13,L14,Lm12,Lm13,Lm14},M12=Medio[Punto[L4Ref[[1]],L4Ref[[2]]],Punto[L4Ref[[3]],L4Ref[[4]]]];M13=Medio[Punto[L4Ref[[1]],L4Ref[[3]]],Punto[L4Ref[[2]],L4Ref[[4]]]];M14=Medio[Punto[L4Ref[[1]],L4Ref[[4]]],Punto[L4Ref[[2]],L4Ref[[3]]]];L12=Recta[Punto[L4Ref[[1]],L4Ref[[2]]],Punto[L4Ref[[3]],L4Ref[[4]]]];L13=Recta[Punto[L4Ref[[1]],L4Ref[[3]]],Punto[L4Ref[[2]],L4Ref[[4]]]];L14=Recta[Punto[L4Ref[[1]],L4Ref[[4]]],Punto[L4Ref[[2]],L4Ref[[3]]]];S2=Punto[L13,L14];S3=Punto[L12,L14];S4=Punto[L12,L13];Lm12=Recta[M12,S2];Lm13=Recta[M13,S3];Lm14=Recta[M14,S4];T2=Punto[Lm13,Lm14];T3=Punto[Lm12,Lm14];C3is1[Punto[Recta[S2,T2],Recta[S3,T3]]]]
L4QLP14[L4Ref_]:=DividirSegmento[L4QLP8[L4Ref],L4QLP12[L4Ref],4,-1]
L4QLP15[L4Ref_]:=DividirSegmento[L4QLP8[L4Ref],L4QLP12[L4Ref],2,1]
L4QLP16[L4Ref_]:=SimetriaCentral[L4QLP10[L4Ref],L4QLP1[L4Ref]]
L4QLP24[L4Ref_]:=Pie[L4QLP16[L4Ref],Recta[L4QLP1[L4Ref],L4QLP8[L4Ref]]]
L4QLP17[L4Ref_]:=SimetriaAxial[L4QLP24[L4Ref],Recta[L4QLP6[L4Ref],L4QLP9[L4Ref]]]
L4QLP18[L4Ref_]:=SimetriaCentral[L4QLP8[L4Ref],L4QLP12[L4Ref]]
L4QLP19[L4Ref_]:=Medio[L4QLP1[L4Ref],L4QLP7[L4Ref]]
L4QLP22[L4Ref_]:=Punto[Recta[L4QLP2[L4Ref],L4QLP4[L4Ref]],Recta[L4QLP5[L4Ref],L4QLP12[L4Ref]]]
L4QLP20[L4Ref_]:=SimetriaCentral[L4QLP5[L4Ref],L4QLP22[L4Ref]]
L4QLP21[L4Ref_]:=SimetriaCentral[L4QLP1[L4Ref],L4QLP20[L4Ref]]
L4QLP23[L4Ref_]:=Punto[Perpendicular[L4QLP18[L4Ref],Recta[L4QLP1[L4Ref],L4QLP7[L4Ref]]],Recta[L4QLP5[L4Ref],L4QLP12[L4Ref]]]
L4QLP25[L4Ref_]:=DividirSegmento[L4QLP17[L4Ref],L4QLP8[L4Ref],3,-1]
L4QLP26[L4Ref_]:=Module[{CC},CC=CentroConica[Numerator[Together[CuadradoDistanciaPuntoRecta[{x,y,z},L4Ref[[1]]]+CuadradoDistanciaPuntoRecta[{x,y,z},L4Ref[[2]]]+CuadradoDistanciaPuntoRecta[{x,y,z},L4Ref[[3]]]+CuadradoDistanciaPuntoRecta[{x,y,z},L4Ref[[4]]]]]];CC/CC[[3]]]
L4QLP27[L4Ref_]:=DividirSegmento[L4QLP4[L4Ref],L4QLP5[L4Ref],2,1]
L4QLP28[L4Ref_]:=Circuncentro[{L3X186[Delete[L4Ref,1]],L3X186[Delete[L4Ref,2]],L3X186[Delete[L4Ref,3]]}]
L4QLP29[L4Ref_]:=Circuncentro[{L3X265[Delete[L4Ref,1]],L3X265[Delete[L4Ref,2]],L3X265[Delete[L4Ref,3]]}]
L4QLP29a[L4Ref_]:=DividirSegmento[L4QLP2[L4Ref],L4QLP3[L4Ref],-1,2]
L4QLP30[L4Ref_]:=DividirSegmento[L4QLP2[L4Ref],L4QLP4[L4Ref],1,2]
L4X5961[L4Ref_]:=Circuncentro[{L3X5961[Delete[L4Ref,1]],L3X5961[Delete[L4Ref,2]],L3X5961[Delete[L4Ref,3]]}]
L4X5962[L4Ref_]:=Circuncentro[{L3X5962[Delete[L4Ref,1]],L3X5962[Delete[L4Ref,2]],L3X5962[Delete[L4Ref,3]]}]
L4X5963[L4Ref_]:=Circuncentro[{L3X5963[Delete[L4Ref,1]],L3X5963[Delete[L4Ref,2]],L3X5963[Delete[L4Ref,3]]}]
L4X5964[L4Ref_]:=Circuncentro[{L3X5964[Delete[L4Ref,1]],L3X5964[Delete[L4Ref,2]],L3X5964[Delete[L4Ref,3]]}]

nL-Point functions

nP1[nLines_]:=Module[{O1,O2,O12},O1=nP3[Delete[nLines,1]];O2=nP3[Delete[nLines,2]];If[Length[nLines]==4,O12=Cross[nLines[[3]],nLines[[4]]],O12=nP3[Delete[nLines,{{1},{2}}]]];C3is1[SimetriaAxial[O12,Recta[O1,O2]]]] (* nL-Miquel Point *)
nP2[nLines_]:=Module[{n},n=Length[nLines];C3is1[DividirSegmento[nP3[nLines],nP4[nLines],n-2,2]]](* nL-Morley's Centroid *)
nP3[nLines_]:=Module[{n,mLines},n=Length[nLines];If[n==2,Cross[nLines[[1]],nLines[[2]]],If[n==3,L3X3[nLines],mLines=Subsets[nLines,{n-1}];C3is1[Circuncentro[{nP3[mLines[[1]]],nP3[mLines[[2]]],nP3[mLines[[3]]]}]]]]] (* nL-Centric Center *)
nP4[nLines_]:=Module[{n,L5a,L5b},n=Length[nLines];If[n==3,L3X4[nLines],
L5a=Perpendicular[nP5[Delete[nLines,1]],nLines[[1]]];
L5b=Perpendicular[nP5[Delete[nLines,2]],nLines[[2]]];C3is1[Cross[L5a,L5b]]]]  (* nL-Morley's Second Orthocenter *)
nP5[nLines_]:=Module[{n},n=Length[nLines];C3is1[DividirSegmento[nP3[nLines],nP4[nLines],n-2,1]]]  (* nL-Morley's Second Circle Center *)
nP6[nLines_]:=Module[{pO,A,B,aLines,bLines,Go,Ga,Gb,Sa,Sb,A1,B1},
pO={-12,-12,1};A={-15,-14,1};B={-10,-8,1};Go=PCentroid[Map[Pie[pO,#]&,nLines]];
aLines=Map[Paralela[A,#]&,nLines];Ga=PCentroid[Map[Pie[pO,#]&,aLines]];
bLines=Map[Paralela[B,#]&,nLines];Gb=PCentroid[Map[Pie[pO,#]&,bLines]];
Sa=Cross[Cross[Ga,Go],Cross[pO,Gb]];Sb=Cross[Cross[Gb,Go],Cross[pO,Ga]];
A1=C3is1[DividirSegmento[pO,A,Abs[Sqrt[CuadradoDistancia[Go,Sa]]],-Abs[Sqrt[CuadradoDistancia[Go,Ga]]]]];
B1=C3is1[DividirSegmento[pO,B,Abs[Sqrt[CuadradoDistancia[Go,Sb]]],-Abs[Sqrt[CuadradoDistancia[Go,Gb]]]]];
N[SumVectorPoint[pO,{A1,B1}]]];  (* nL-LSD point *)
nP7[nLines_]:=Module[{O,n,mLines},O=nP3[nLines];n=Length[nLines];mLines=Subsets[nLines,{n-1}];C3is1[SumVectorPoint[O,Map[nP3[#]&,mLines]]]];   (* nL-Hervey Point/SVP point *)
nP8[nLines_]:=Module[{n,mLines},n=Length[nLines];If[n==3,L3X2[nLines],mLines=Subsets[nLines,{n-1}];PCentroid[Map[nP8[#]&,mLines]]]]   (* nL-(MVP-)Centroid *)
nP9[nLines_]:=Module[{n,mLines},n=Length[nLines];If[n==3,L3X3[nLines],mLines=Subsets[nLines,{n-1}];PCentroid[Map[nP9[#]&,mLines]]]]   (* nL-MVP-Circumcenter *)
nP10[nLines_]:=Module[{n,mLines,nG,nP},n=Length[nLines];If[n==3,L3X4[nLines],mLines=Subsets[nLines,{n-1}];PCentroid[Map[nP10[#]&,mLines]]]]   (* nL-MVP-Orthocenter *)
nP11[nLines_]:=Module[{n,mLines,nG,nP},n=Length[nLines];If[n==3,L3X5[nLines],mLines=Subsets[nLines,{n-1}];PCentroid[Map[nP11[#]&,mLines]]]]   (* nL-MVP-Nine-point Center *)

oP1[nLines_]:=Module[{n,h},n=Length[nLines];h=(n-1)/2;nLpi[nLines,h]]  (* oL-Morley's first Orthocenter *)
oP2[nLines_]:=Module[{n,O1,O2,O3},n=Length[nLines];If[n==3,L3X3[nLines],O1=eP2[Delete[nLines,1]];O2=eP2[Delete[nLines,2]];O3=eP2[Delete[nLines,3]];C3is1[Circuncentro[{O1,O2,O3}]]]]   (* nL-Clifford's Circle Center *)

eP1[nLines_]:=Module[{n,h},n=Length[nLines];h=(n/2-1);nLpi[nLines,h]]  (* eL-Morley's Inscribed EnnaDeltoid Center *)
eP2[nLines_]:=Module[{n,O1,O2,O12},n=Length[nLines];If[n==2,Cross@@nLines,O1=oP2[Delete[nLines,1]];O2=oP2[Delete[nLines,2]];O12=eP2[Delete[nLines,{{1},{2}}]];C3is1[SimetriaAxial[O12,Recta[O1,O2]]]]]   (* nL-Clifford's Point *)

nL - Lines

nL1[nLines_]:=Recta[nP3[nLines],nP4[nLines]]   (* nL-Morley Eulerline *)
nL2[nLines_]:=Recta[nP8[nLines],nP9[nLines]]   (* nL-MVP Eulerline *)
oL1[nLines_]:=Recta[oP1[nLines],nP4[nLines]]   (* oL-Morley's Line of Orthocenters *)
oL2[nLines_]:=Module[{n,mLines},n=Length[nLines];mLines=Subsets[nLines,{n-1}];C3is1[Recta[eP1[mLines[[1]]],eP1[mLines[[2]]]]]]   (* oL-EnnaDeltoid Center line *)
eL1[nLines_]:=Module[{n},n=Length[nLines];C3is1[Mediatriz[nLpi[nLines,n/2-1],nLpi[nLines,n/2]]]]    (* eL-Morley's Ortho Directrix *)

nL - Circles

nCi1[nLines_]:=Module[{mLines},mLines=Subsets[nLines,{Length[nLines]-1}];CircunferenciaTresPuntos[{nP3[mLines[[1]]],nP3[mLines[[2]]],nP3[mLines[[3]]]}]]            (* nL-Center Circle *)
nCi2[nLines_]:=Module[{n,mLines,Radius},n=Length[nLines];mLines=Subsets[nLines,{n-1}];Radius=Sqrt[CuadradoDistancia[nP3[nLines],nP3[mLines[[1]]]]];Circunferencia[nP5[nLines],Radius/(n-1)]]                                                                                               (* nL-Morley's Second Circle *)
oCi1[nLines_]:=Module[{mLines},mLines=Subsets[nLines,{Length[nLines]-1}];CircunferenciaTresPuntos[{eP2[mLines[[1]]],eP2[mLines[[2]]],eP2[mLines[[3]]]}]]            (* nL-Clifford's Circle *)

5L - Conic

L5sCo1[L1_,L2_,L3_,L4_,L5_]:=Module[{S12,S13,S14,S15,S23,S24,S25,S34,S35,S45,T1,T2,T3,T4,T5},S12=Punto[L1,L2];S13=Punto[L1,L3];S14=Punto[L1,L4];S15=Punto[L1,L5];S23=Punto[L2,L3];S24=Punto[L2,L4];S25=Punto[L2,L5];S34=Punto[L3,L4];S35=Punto[L3,L5];S45=Punto[L4,L5];T1=Punto[L1,Recta[S34,Punto[Recta[S15,S23],Recta[S12,S45]]]];T2=Punto[L2,Recta[S45,Punto[Recta[S12,S34],Recta[S23,S15]]]];T3=Punto[L3,Recta[S15,Punto[Recta[S23,S45],Recta[S34,S12]]]];T4=Punto[L4,Recta[S12,Punto[Recta[S34,S15],Recta[S45,S23]]]];
T5=Punto[L5,Recta[S23,Punto[Recta[S45,S12],Recta[S15,S34]]]];ConicaCincoPuntos[T1,T2,T3,T4,T5]]

nL-Morley's recursive pi-Points and gi-Points

Note :  i = 1 produces nL-p0,  i = 2 produces nL-p1, etc.
           nLines = list of basic lines of the n-Line

nLpi[nLines_,i_]:=Module[{n,nG,nP},n=Length[nLines];If[i==0,nP3[nLines],nG=nLgi[nLines,i-1];nP=nLpi[nLines,i-1];C3is1[DividirSegmento[nP,nG,n,i-n]]]]
nLgi[nLines_,i_]:=Module[{n,mLines},n=Length[nLines];If[n==2,Cross[nLines[[1]],nLines[[2]]],mLines=Subsets[nLines,{n-1}];C3is1[PCentroid[Map[nLpi[#,i]&,mLines]]]]]

nL-Px-Par Points

HC[Ln1_,Ln2_]:=Module[{n,dl,Sl12,Sm12,Sl13,Sm13,XX,YY},n=Length[Ln1];dl=Abs[CheckLn1Ln2[Ln1,Ln2]];If[dl>10^(-8),Print["No homothecy at level ",n, " ,dl= ",dl]];Sl12=C3is1[Ln1[[1]]\[Cross]Ln1[[2]]];Sm12=C3is1[Ln2[[1]]\[Cross]Ln2[[2]]];Sl13=C3is1[Ln1[[1]]\[Cross]Ln1[[3]]];Sm13=C3is1[Ln2[[1]]\[Cross]Ln2[[3]]];C3is1[(Sl12\[Cross]Sm12)\[Cross](Sl13\[Cross]Sm13)]]
GonPoints[Ln1_]:={C3is1[Cross[Ln1[[1]],Ln1[[2]]]],C3is1[Cross[Ln1[[2]],Ln1[[3]]]],C3is1[Cross[Ln1[[3]],Ln1[[4]]]],C3is1[Cross[Ln1[[4]],Ln1[[1]]]]}
CheckLn1Ln2[Ln1_,Ln2_]:=Module[{S12,S23,S34,S41,T12,T23,T34,T41,ST},{S12,S23,S34,S41}=GonPoints[Ln1];{T12,T23,T34,T41}=GonPoints[Ln2];ST={C3is1[Cross[S12,T12]],C3is1[Cross[S23,T23]],C3is1[Cross[S34,T34]],C3is1[Cross[S41,T41]]};Det[Drop[ST,1]]*Det[Drop[ST,-1]]]
nQxParLines[nLines_,Pointname_]:=Module[{n,PointVersion},n=Length[nLines];PointVersion=Table[C3is1[nQx[Delete[nLines,i],Pointname]],{i,1,n,1}];
Table[C3is1[Paralela[PointVersion[[i]],nLines[[i]]]],{i,1,n,1}]]
nQx[nLines_,Pointname_]:=Module[{n},n=Length[nLines];
If[n==4,N[C3is1[Pointname[nLines]]],HC[nQxParLines[nLines,Pointname],nQxParLines[nQxParLines[nLines,Pointname],Pointname]]]]
(* Recursive Par1/Par2-Homothetic Center of a QL-point in an n-Line *)

Identities and Collinearities

IdentitiesQ[P_,Q_]:=Abs[P[[1]]*Q[[2]]-P[[2]]*Q[[1]]]<0.000001∧Abs[P[[1]]*Q[[3]]-P[[3]]*Q[[1]]]<0.000001;
Identities[allpoints_]:=Module[{ident},ident={};n=Length[allpoints];
For[i=1,i<n+1,i++,For[j=i+1,j<n+1,j++,
If[IdentitiesQ[allpoints[[i,2]],allpoints[[j,2]]],ident=Join[ident,{{j}}];Print[allpoints[[i,1]],"(",i,")","=",allpoints[[j,1]],"(",j,")"]]]];ident]
ExclusivePoints[points_]:=
Module[{allpoints,identicals,n},allpoints=points;identicals={};n=Length[allpoints];
For[i=1,i<n+1,i++,
For[j=i+1,j<n+1,j++,
If[IdentitiesQ[allpoints[[i,2]],allpoints[[j,2]]],identicals=Join[identicals,{{j}}];
allpoints[[i,1]]=StringJoin[allpoints[[i,1]],"/",allpoints[[j,1]]]]]];
Delete[allpoints,identicals]]

Collinearities based upon table with "names" and their numeric barycentric/projective coordinates

CollinearQ[threepoints_]:=
Abs[Det[points[[threepoints]][[All,2]]]]<0.00000000001;
SameLineQ[{i_,j_},{m_,n_}]:=
And[CollinearQ[{i,j,m}],CollinearQ[{i,j,n}]];
LyingOnLine[line_]:=
points[[Select[Range[Length[points]],CollinearQ[Append[line,#]]&]]][[All,1]];
HyphenedCounter[point_]:=Module[{length},length=Length[Select[distinctlines,MemberQ[#,point]&]];{point,length,StringJoin[Table["-",{length}]]}]
Collinearities[points_]:=Map[LyingOnLine,
DeleteDuplicates[Union[Map[Drop[#,-1]&,Select[Subsets[Range[Length[points]],{3}],CollinearQ]]],SameLineQ]]
Collinearities2[distinctlines_,points_]:=TableForm[Map[HyphenedCounter,points[[All,1]]]]

Example in a 4-Line

Arranging the items to inspect

Clear[L4n1,L4n2,L4n3,L4n4,L4n5,L4n6,L4n7,L4n8,L4n9,L4n10,L4n11,L4n12,L4n13,L4n14,L4ep1,L4ep2]
allpoints= Transpose[{Map[ToString, #], #} &[{L4n1,L4n2,L4n3,L4n4,L4n5,L4n6,L4n7,L4n8,L4n9,L4n10,L4n11,L4n12,L4n13,L4n14,L4ep1,L4ep2}]];

Calculatinging the items to inspect

nLines=n4Lines;
L4n1=nP1[nLines];L4n2=nP2[nLines];L4n3=nP3[nLines];L4n4=nP4[nLines];L4n5=nP5[nLines];L4n6=nP6[nLines];L4n7=nP7[nLines];
L4n8=nP8[nLines];L4n9=nP9[nLines];L4n10=nP10[nLines];L4n11=nP11[nLines];L4n12=N[L4QLP4[n4Lines]];L4n13=N[L4QLP28[n4Lines]];L4n14=N[L4QLP29[n4Lines]];L4ep1=eP1[nLines];L4ep2=eP2[nLines];
N[allpoints];

Inspection of identical cases and collinearities
Note: the points & distinctlines have to be mentioned as below

points=N[ExclusivePoints[allpoints]];
distinctlines=Collinearities[points];
distinctlines//TableForm
Collinearities2[distinctlines,points]

Distance ratios

Sqrt[CuadradoDistancia[L4n3,L4n4]/CuadradoDistancia[L4n3,L4n2]]

----------------------------------------------------------------------------------------------------------------------
Example in a 5-Line

Arranging the items to inspect

Clear[L5n1,L5n2,L5n3,L5n4,L5n5,L5n6,L5n7,L5n8,L5n9,L5n10,L5n11,L5n12,L5n13,L5n14,L5op1,L5op2]
allpoints= Transpose[{Map[ToString, #], #} &[{L5n1,L5n2,L5n3,L5n4,L5n5,L5n6,L5n7,L5n8,L5n9,L5n10,L5n11,L5n12,L5n13,L5n14,L5op1,L5op2}]];

Calculating the items to inspect

n5Lines={{0,5,-10},{-2,1,20},{-4,-4,64},{3,-3,0},{3,1,-20}};
n5Lines={{0.1,5,-10},{-2.1,1,20},{-4.1,-4,64},{3.1,-3,0},{3.1,1,-20}};
nLines=n5Lines;
L5n1=nP1[nLines];L5n2=nP2[nLines];L5n3=nP3[nLines];L5n4=nP4[nLines];L5n5=nP5[nLines];L5n6=nP6[nLines];L5n7=nP7[nLines];
L5n8=nP8[nLines];L5n9=nP9[nLines];L5n10=nP10[nLines];L5n11=nP11[nLines];L5n12=nQx[nLines,L4QLP4];L5n13=nQx[nLines,L4QLP28];L5n14=nQx[nLines,L4QLP29];L5op1=oP1[nLines];L5op2=oP2[nLines];
N[allpoints];

Inspection of identical cases and collinearities
Note: the points & distinctlines have to be mentioned as below

points=N[ExclusivePoints[allpoints]];
distinctlines=Collinearities[points];
distinctlines//TableForm
Collinearities2[distinctlines,points]

----------------------------------------------------------------------------------------------------------------------
Example in a 6-Line

Arranging the items to inspect

Clear[L6n1,L6n2,L6n3,L6n4,L6n5,L6n6,L6n7,L6n8,L6n9,L6n10,L6n11,L6n12,L6n13,L6n14]
allpoints= Transpose[{Map[ToString, #], #} &[{L6n1,L6n2,L6n3,L6n4,L6n5,L6n6,L6n7,L6n8,L6n9,L6n10,L6n11,L6n12,L6n13,L6n14}]];

Calculating the items to inspect

nLines=n6Lines;
L6n1=nP1[nLines];L6n2=nP2[nLines];L6n3=nP3[nLines];L6n4=nP4[nLines];L6n5=nP5[nLines];L6n6=nP6[nLines];L6n7=nP7[nLines];
L6n8=nP8[nLines];L6n9=nP9[nLines];L6n10=nP10[nLines];L6n11=nP11[nLines];L6n12=nQx[nLines,L4QLP4];L6n13=nQx[nLines,L4QLP28];L6n14=nQx[nLines,L4QLP29];(*L6op1=oP1[nLines];L6op2=oP2[nLines]; they give problems *)
N[allpoints];

Inspection of identical cases and collinearities
Note: the points & distinctlines have to be mentioned as below

points=N[ExclusivePoints[allpoints]];
distinctlines=Collinearities[points];
distinctlines//TableForm
Collinearities2[distinctlines,points]

G R A P H I C S

Picture of nL-points where n = EVEN

Definition n - Line

S81={5.1,3,1};S12={12,3,1};S23={14,5,1};S34={15,8,1};S45={13,11,1};S56={9,13,1};S67={3,10,1};S78={2,6,1};n8Gon={S81,S12,S23,S34,S45,S56,S67,S78,S81};
L1=Recta[S81,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S56];L6=Recta[S56,S67];L7=Recta[S67,S78];L8=Recta[S78,S81];n8Lines={L1,L2,L3,L4,L5,L6,L7,L8};

nLines=n8Lines;nGon=n8Gon;

Calculation n - Points

nLnP1=nP1[nLines];nLnP2=nP2[nLines];nLnP3=nP3[nLines];nLnP4=nP4[nLines];nLnP5=nP5[nLines];nLnP6=nP6[nLines];nLnP7=nP7[nLines];nLnP8=nP8[nLines];nLnP9=nP9[nLines];nLnP10=nP10[nLines];nLnP11=nP11[nLines];

nLeP1=eP1[nLines];
nLeP2=eP2[nLines];

Specialties

nLnCi1=nCi1[nLines]; (* Center Circle *)
nLnCi2=nCi2[nLines]; (* Morley's Second Circle *)
nLeL1=eL1[nLines];      (* oL-Morley's Ortho Directrix *)
EL1=Cross[nLnP3,nLnP4];EL2=Cross[nLnP9,nLnP10];  (* Euler Lines *)
P0=nLpi[nLines,0];G0=nLgi[nLines,0];
P1=nLpi[nLines,1];G1=nLgi[nLines,1];
P2=nLpi[nLines,2];G2=nLgi[nLines,2];
P3=nLpi[nLines,3];G3=nLgi[nLines,3];
P4=nLpi[nLines,4];

Clifford' s Circles:

mLines=Subsets[nLines,{Length[nLines]-1}];
mLoCi1a=oCi1[mLines[[1]]];mLoCi1b=oCi1[mLines[[2]]];mLoCi1c=oCi1[mLines[[3]]];mLoCi1d=oCi1[mLines[[4]]];mLoCi1e=oCi1[mLines[[5]]];mLoCi1f=oCi1[mLines[[6]]];mLoCi1g=oCi1[mLines[[7]]];mLoCi1h=oCi1[mLines[[8]]];

eL-Picture - - - - - - - - - - - - - - - - - - - - - - - - - -

xmin=-7;xmax=29;ymin=-10;ymax=26;
LeftUnder={xmin+1,ymin+1,1};
{lu,np1,np2,np3,np4,np5,np6,np7,np8,np9,np10,np11,ep1,ep2,g0,g1,g2,g3,p1,p2,p3,p4}=Map[CartesianPoint,{LeftUnder,nLnP1,nLnP2,nLnP3,nLnP4,nLnP5,nLnP6,nLnP7,nLnP8,nLnP9,nLnP10,nLnP11,nLeP1,nLeP2,G0,G1,G2,G3,P1,P2,P3,P4}];
Ci1=nLnCi1/.z->1;Ci2=nLnCi2/.z->1;
oCi1a=mLoCi1a/.z->1;oCi1b=mLoCi1b/.z->1;oCi1c=mLoCi1c/.z->1;oCi1d=mLoCi1d/.z->1;oCi1e=mLoCi1e/.z->1;oCi1f=mLoCi1f/.z->1;oCi1g=mLoCi1g/.z->1;oCi1h=mLoCi1h/.z->1;
l1=L1.{x,y,1};l2=L2.{x,y,1};l3=L3.{x,y,1};l4=L4.{x,y,1};l5=L5.{x,y,1};l6=L6.{x,y,1};l7=L7.{x,y,1};
el1=EL1.{x,y,1};el2=EL2.{x,y,1};md=nLeL1.{x,y,1};
GeneralPosition={1.5,-.5};
GeneralPosition2={1.5,1};
Show[{
ContourPlot[Ci1==0,{x,xmin,xmax},{y,ymin,ymax},Frame->False],
ContourPlot[Ci2==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Directive[Dashed]}],
ContourPlot[oCi1a==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[oCi1b==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[oCi1c==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[oCi1d==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[oCi1e==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[oCi1f==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[oCi1g==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[oCi1h==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[el1==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Red,Directive[Red,Dashed]}],
ContourPlot[el2==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Red,Directive[Red,Dashed]}],
ContourPlot[md==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Gray}],
(*ContourPlot[l1==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l2==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l3==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l4==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l5==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l6==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l7==0,{x,xmin,xmax},{y,ymin,ymax}],*)

Graphics[{Style[Text["Points/Lines/Curves in an 8-Line",lu,{-2.3,0}],15,Bold,Italic,Gray],
Style[Text["P1",np1,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P2",np2,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P3",np3,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P4",np4,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P5",np5,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P6",np6,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P7",np7,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P8",np8,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P9",np9,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P10",np10,GeneralPosition],11,Bold,Italic,Red],
Style[Text["P11",np11,GeneralPosition],11,Bold,Italic,Red],
Style[Text["eP1",ep1,GeneralPosition],11,Bold,Italic,Red],
Style[Text["eP2",ep2,GeneralPosition],11,Bold,Italic,Red],
Style[Text["go",g0,GeneralPosition],11,Bold,Italic,Black],
Style[Text["g1",g1,GeneralPosition],11,Bold,Italic,Black],
Style[Text["g2",g2,GeneralPosition],11,Bold,Italic,Black],
Style[Text["g3",g3,GeneralPosition],11,Bold,Italic,Black],
Style[Text["=p1",p1,GeneralPosition2],11,Bold,Italic,Black],
Style[Text["p2",p2,GeneralPosition],11,Bold,Italic,Black],
Style[Text["=p3",p3,GeneralPosition2],11,Bold,Italic,Black],
Style[Text["p4",p4,GeneralPosition],11,Bold,Italic,Black],
Thickness[0.0005],Arrowheads[.01],
Arrow[{np3,np7}],
Arrow[{np7,p2}],
Arrow[{p2,p3}],
Arrow[{p3,p4}],
Thickness[0.001],Blue,
Line[{Map[CartesianPoint,nGon]}],
Black,
PointSize[0.005],
Map[Point,{np1,np2,np3,np4,np5,np6,np7,np8,np9,np10,np11,ep1,ep2,g0,g1,g2,g3,p2,p3,p4}]
}]
},Background->RGBColor[1,1,1]]

Picture of all nL-points where n = ODD

5 - LINE

S51={6,2,1};S12={11,2,1};S23={12,4,1};S34={8,8,1};S45={5,5,1};n5Gon={S51,S12,S23,S34,S45,S51};
S51={6,2,1};S12={11,2,1};S23={12,4,1};S34={8,8,1};S45={5.1,5,1};n5Gon={S51,S12,S23,S34,S45,S51};
L1=Recta[S51,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S51];n5Lines={L1,L2,L3,L4,L5};

START

nLines=n5Lines;nGon=n5Gon;

Calculation nL - Points

nLnP1=nP1[nLines];nLnP2=nP2[nLines];nLnP3=nP3[nLines];nLnP4=nP4[nLines];nLnP5=nP5[nLines];nLnP6=nP6[nLines];nLnP7=nP7[nLines];nLnP8=nP8[nLines];nLnP9=nP9[nLines];nLnP10=nP10[nLines];nLnP11=nP11[nLines];
nLoP1=oP1[nLines];nLoP2=oP2[nLines];

Specialties

nLoCi1

nLnCi1=nCi1[nLines]; (* Center Circle *)
nLnCi2=nCi2[nLines]; (* Morley's Second Circle *)
nLoCi1=oCi1[nLines]; (* Clifford's Circle *)
EL1=Cross[nLnP3,nLnP4];EL2=Cross[nLnP9,nLnP10];  (* Euler Lines *)
nLoL2=oL2[nLines];     (* oL-EnnaDeltoid Center Line*)
P0=nLpi[nLines,0];G0=nLgi[nLines,0];
P1=nLpi[nLines,1];G1=nLgi[nLines,1];
P2=nLpi[nLines,2];G2=nLgi[nLines,2];
P3=nLpi[nLines,3];G3=nLgi[nLines,3];
P4=nLpi[nLines,4];

Graphing

LeftUnder={xmin+1,ymin+1,1};
{lu,np1,np2,np3,np4,np5,np6,np7,np8,np9,np10,np11,op1,op2,g0,g1,g2,g3,p2,p3,p4}=Map[CartesianPoint,{LeftUnder,nLnP1,nLnP2,nLnP3,nLnP4,nLnP5,nLnP6,nLnP7,nLnP8,nLnP9,nLnP10,nLnP11,nLoP1,nLoP2,G0,G1,G2,G3,P2,P3,P4}];
nCi1=nLnCi1/.z->1;nCi2=nLnCi2/.z->1;oCi1=nLoCi1/.z->1;
l1=L1.{x,y,1};l2=L2.{x,y,1};l3=L3.{x,y,1};l4=L4.{x,y,1};l5=L5.{x,y,1};l6=L6.{x,y,1};l7=L7.{x,y,1};
el1=EL1.{x,y,1};el2=EL2.{x,y,1};ol2=nLoL2.{x,y,1};
xmin=-8;xmax=15;ymin=-10;ymax=13;
GeneralPosition={1.3,-.3};
GeneralPosition2={-1.3,.5};
GeneralColour=Black;
Show[{
ContourPlot[nCi1==0,{x,xmin,xmax},{y,ymin,ymax},Frame->False],
ContourPlot[nCi2==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Directive[Dashed]}],
ContourPlot[oCi1==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[el1==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Black,Directive[Dashed]}],
ContourPlot[el2==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Black,Directive[Dashed]}],
ContourPlot[ol2==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Blue,Directive[Dashed]}],
(*ContourPlot[l1==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l2==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l3==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l4==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l5==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l6==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l7==0,{x,xmin,xmax},{y,ymin,ymax}],*)

Graphics[{Style[Text["Points/Lines/Curves in a 5-Line",lu,{-3.1,0}],15,Bold,Italic,Gray],
Style[Text["P1",np1,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P2",np2,GeneralPosition2],11,Bold,Italic,GeneralColour],
Style[Text["P3",np3,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P4",np4,GeneralPosition2],11,Bold,Italic,GeneralColour],
Style[Text["P5",np5,GeneralPosition2],11,Bold,Italic,GeneralColour],
Style[Text["P6",np6,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P7",np7,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P8",np8,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P9",np9,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P10",np10,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P11",np11,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["oP1",op1,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["oP2",op2,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["go",g0,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["g1",g1,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["go",g0,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["g1",g1,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["g2",g2,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["g3",g3,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["p2",p2,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["p3",p3,GeneralPosition],11,Bold,Italic,GeneralColour],
Thickness[0.0005],Arrowheads[.01],
Arrow[{np3,np7}],
Arrow[{np7,p2}],
Arrow[{p2,p3}],
Arrow[{p3,p4}],
Thickness[0.001],Blue,
Line[{Map[CartesianPoint,nGon]}],
Black,
PointSize[0.005],
Map[Point,{np1,np2,np3,np4,np5,np6,np7,np8,np9,np10,np11,op1,op2,g0,g1,g2,g3,p2,p3,p4}]
}]
},Background->RGBColor[1,1,1]]

9 - LINE

Definition n - Line

S71={7.05,6,1};S12={13,6,1};S23={15.5,9,1};S34={14,12,1};S45={10,14,1};S56={7,11.5,1};S67={6.05,9,1};n7Gon={S71,S12,S23,S34,S45,S56,S67,S71};
L1=Recta[S71,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S56];L6=Recta[S56,S67];L7=Recta[S67,S71];
n7Lines={L1,L2,L3,L4,L5,L6,L7};

nLines=n9Lines;nGon=n9Gon;

Calculation nL - Points

nLnP1=nP1[nLines];nLnP2=nP2[nLines];nLnP3=nP3[nLines];nLnP4=nP4[nLines];nLnP5=nP5[nLines];nLnP6=nP6[nLines];nLnP7=nP7[nLines];nLnP8=nP8[nLines];nLnP9=nP9[nLines];nLnP10=nP10[nLines];nLnP11=nP11[nLines];
nLoP1=oP1[nLines];nLoP2=oP2[nLines];

Specialties

nLnCi1=nCi1[nLines]; (* Center Circle *)
nLnCi2=nCi2[nLines]; (* Morley's Second Circle *)
nLoCi1=oCi1[nLines]; (* Clifford's Circle *)
EL1=Cross[nLnP3,nLnP4];EL2=Cross[nLnP9,nLnP10];  (* Euler Lines *)
nLoL2=oL2[nLines];     (* oL-EnnaDeltoid Center Line*)
P0=nLpi[nLines,0];G0=nLgi[nLines,0];
P1=nLpi[nLines,1];G1=nLgi[nLines,1];
P2=nLpi[nLines,2];G2=nLgi[nLines,2];
P3=nLpi[nLines,3];G3=nLgi[nLines,3];
P4=nLpi[nLines,4];

Graphing

LeftUnder={xmin+1,ymin+1,1};
{lu,np1,np2,np3,np4,np5,np6,np7,np8,np9,np10,np11,op1,op2,g0,g1,g2,g3,p2,p3,p4}=Map[CartesianPoint,{LeftUnder,nLnP1,nLnP2,nLnP3,nLnP4,nLnP5,nLnP6,nLnP7,nLnP8,nLnP9,nLnP10,nLnP11,nLoP1,nLoP2,G0,G1,G2,G3,P2,P3,P4}];
nCi1=nLnCi1/.z->1;nCi2=nLnCi2/.z->1;oCi1=nLoCi1/.z->1;
l1=L1.{x,y,1};l2=L2.{x,y,1};l3=L3.{x,y,1};l4=L4.{x,y,1};l5=L5.{x,y,1};l6=L6.{x,y,1};l7=L7.{x,y,1};
el1=EL1.{x,y,1};el2=EL2.{x,y,1};ol2=nLoL2.{x,y,1};
xmin=-15;xmax=30;ymin=-15;ymax=30;
GeneralPosition={1.3,-.3};
GeneralPosition2={-1.3,.5};
GeneralColour=Black;
Show[{
ContourPlot[nCi1==0,{x,xmin,xmax},{y,ymin,ymax},Frame->False],
ContourPlot[nCi2==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Directive[Dashed]}],
ContourPlot[oCi1==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Orange}],
ContourPlot[el1==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Black,Directive[Dashed]}],
ContourPlot[el2==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Black,Directive[Dashed]}],
ContourPlot[ol2==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->{Blue,Directive[Dashed]}],
(*ContourPlot[l1==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l2==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l3==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l4==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l5==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l6==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l7==0,{x,xmin,xmax},{y,ymin,ymax}],*)

Graphics[{Style[Text["Points/Lines/Curves in a 9-Line",lu,{-3.1,0}],15,Bold,Italic,Gray],
Style[Text["P1",np1,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P2",np2,GeneralPosition2],11,Bold,Italic,GeneralColour],
Style[Text["P3",np3,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P4",np4,GeneralPosition2],11,Bold,Italic,GeneralColour],
Style[Text["P5",np5,GeneralPosition2],11,Bold,Italic,GeneralColour],
Style[Text["P6",np6,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P7",np7,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P8",np8,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P9",np9,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P10",np10,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["P11",np11,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["oP1",op1,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["oP2",op2,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["go",g0,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["g1",g1,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["go",g0,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["g1",g1,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["g2",g2,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["g3",g3,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["p2",p2,GeneralPosition],11,Bold,Italic,GeneralColour],
Style[Text["p3",p3,GeneralPosition],11,Bold,Italic,GeneralColour],
Thickness[0.0005],Arrowheads[.01],
Arrow[{np3,np7}],
Arrow[{np7,p2}],
Arrow[{p2,p3}],
Arrow[{p3,p4}],
Thickness[0.001],Blue,
Line[{Map[CartesianPoint,nGon]}],
Black,
PointSize[0.005],
Map[Point,{np1,np2,np3,np4,np5,np6,np7,np8,np9,np10,np11,op1,op2,g0,g1,g2,g3,p2,p3,p4}]
}]
},Background->RGBColor[1,1,1]]

Morley's pi- and gi- Points

(* basic lines L1, ... , Ln *)
S71={7.05,6,1};S12={13,6,1};S23={15.5,9,1};S34={14,12,1};S45={10,14,1};S56={7,11.5,1};S67={6.1,9,1};
L1=Recta[S71,S12];L2=Recta[S12,S23];L3=Recta[S23,S34];L4=Recta[S34,S45];L5=Recta[S45,S56];L6=Recta[S56,S67];L7=Recta[S67,S71];
nLines={L1,L2,L3,L4,L5,L6,L7};n=Length[nLines];
mLines=Subsets[nLines,{n-1}];
(* p0, g0 *)
P0=nLpi[nLines,0];
Oi={O7,O6,O5,O4,O3,O2,O1}=Map[nLpi[#,0]&,mLines];
G0=PCentroid[Oi];
(* p1, g1 *)
P1=nLpi[nLines,1];
Si={S7,S6,S5,S4,S3,S2,S1}=Map[nLpi[#,1]&,mLines];
G1=PCentroid[Si];
(* p2 *)
P2=nLpi[nLines,2];
Ti={T7,T6,T5,T4,T3,T2,T1}=Map[nLpi[#,2]&,mLines];
G2=PCentroid[Ti];
(* p3 *)
P3=nLpi[nLines,3];
Ui={U7,U6,U5,U4,U3,U2,U1}=Map[nLpi[#,3]&,mLines];

(* other items *)
circun=CircunferenciaTresPuntos[{O1,O2,O3}];   (* Center Circle *)
dT=Sqrt[CuadradoDistancia[P3,T1]]; dU=Sqrt[CuadradoDistancia[P3,U1]];
Ltu=C3is1[Recta[P3,DividirSegmento[T1,U1,dT,dU]]];   (* Angle Bisector-1 at 7L-p3 *)
Ltup=Perpendicular[P3,Ltu];   (* Angle Bisector-2 at 7L-p3 *)

{o1,o2,o3,o4,o5,o6,o7,p0,g0,p1,g1,p2,g2,p3,t1,t2,t3,t4,t5,t6,t7,u1,u2,u3,u4,u5,u6,u7}=Map[CartesianPoint,{O1,O2,O3,O4,O5,O6,O7,P0,G0,P1,G1,P2,G2,P3,T1,T2,T3,T4,T5,T6,T7,U1,U2,U3,U4,U5,U6,U7}];
ccircun=circun/.z->1;
l1=L1.{x,y,1};l2=L2.{x,y,1};l3=L3.{x,y,1};l4=L4.{x,y,1};l5=L5.{x,y,1};l6=L6.{x,y,1};l7=L7.{x,y,1};
ltu=Ltu.{x,y,1};ltup=Ltup.{x,y,1};
xmin=-5;xmax=25;ymin=-5;ymax=25;
Show[{
ContourPlot[ccircun==0,{x,xmin,xmax},{y,ymin,ymax},Frame->False],
ContourPlot[ltu==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->Black],
ContourPlot[ltup==0,{x,xmin,xmax},{y,ymin,ymax},ContourStyle->Black],
(*ContourPlot[l1==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l2==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l3==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l4==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l5==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l6==0,{x,xmin,xmax},{y,ymin,ymax}],
ContourPlot[l7==0,{x,xmin,xmax},{y,ymin,ymax}],*)
Graphics[{
Style[Text["O1",o1,{-1.6,0}],11,Italic,Red],
Style[Text["O2",o2,{-.4,1.3}],11,Italic,Red],
Style[Text["O3",o3,{1.5,0}],11,Italic,Red],
Style[Text["O4",o4,{-.3,-1}],11,Italic,Red],
Style[Text["O5",o5,{-.5,1.5}],11,Italic,Red],
Style[Text["O6",o6,{0,1.5}],11,Italic,Red],
Style[Text["O7",o7,{1.6,0}],11,Italic,Red],
Style[Text["p0",p0,{-1.7,-.5}],13,Italic,Black],
Style[Text["g0",g0,{-1.7,-.5}],13,Italic,Black],
Style[Text["p1",p1,{0,-1.5}],13,Italic,Black],
Style[Text["g1",g1,{0,-1.7}],13,Italic,Black],
Style[Text["p2",p2,{0,-2}],13,Italic,Black],
Style[Text["g2",g2,{-.4,-1.7}],13,Italic,Black],
Style[Text["p3",p3,{-.5,-2}],13,Italic,Black],
Style[Text["6L-p2a",t5,{-.6,-1.5}],11,Italic,Black],
Style[Text["6L-p2b",t2,{-1.2,1}],11,Italic,Black],
Style[Text["6L-p2c",t3,{-1.2,-.3}],11,Italic,Black],
Style[Text["6L-p3a",u5,{1.2,-.3}],11,Italic,Black],
Style[Text["6L-p3b",u2,{1.2,-.3}],11,Italic,Black],
Style[Text["6L-p3c",u3,{1.2,-.3}],11,Italic,Black],
Style[Text["Reflective",p3,{1.6,-2}],13,Italic,Black],
Style[Text["Axes",p3,{2.1,0}],13,Italic,Black],
Style[Text["p0, g0, p1, g1, p2, g2, p3 are actually 7L-p0, 7L-g0, 7L-p1, 7L-g1, 7L-p2, 7L-g2, 7L-p3",o4,{0,9}],12,Black],
Style[Text["O1, ... ,O7 are actually the 7 versions of 6L-p0",o4,{0,12}],12,Black],
Style[Text["7-Line",o7,{7,0}],12,Italic,Blue],
Thickness[0.002],Arrowheads[.02],
Arrow[{p0,p1}],
Arrow[{p1,p2}],
Arrow[{p2,p3}],
Thickness[0.002],
{Dashed,
Line[{p3,t5}],
Line[{p3,t2}],
Line[{p3,t3}],
Line[{p3,u5}],
Line[{p3,u2}],
Line[{p3,u3}]},
Thickness[0.001],Blue,
Line[{Map[CartesianPoint,{S71,S12,S23,S34,S45,S56,S67,S71}]}],
Red,
PointSize[0.007],
Map[Point,{o1,o2,o3,o4,o5,o6,o7,p0,g0,p1,g1,p2,g2,p3,t5,t2,t3,u5,u2,u3}]
}]
},Background->RGBColor[1,1,1]]