initGeo Anwendung

Erst in File GeometrieZirkelUndLineal.nb den Modul "initGeo" (unten) laufen lassen

initGeo[2]

Kurze Tests

?vLen

?vSenkrEben

?maXx

?l2

Show[l2[{1,1},{2,2}], DisplayFunction->$DisplayFunction];

Weitere Tests und Anwendungen

text2H[wort_, p_, distanz_] := 
        Show[Graphics[{Text[wort, p, {0, -distanz}], {PointSize[ .001], 
                Point[p]}}, PlotRange -> All, 
            AspectRatio -> Automatic, 
            DisplayFunction -> Identity]];

h = {0, 1};
g = {(Sqrt[2] + 1)/2, 0};
g1 = {-1/((Sqrt[2] + 1)/2), 
          0};
q1 = g + {0.5, 0};
p1 = {-1/q1[[1]], 0};
q2 = -({-0.5, 0} + p1);
p2 = {-1/q2[[1]], 0};

Show[kartKreuz2[h, g, g1, q1, p1, q2, p2], 
        po2[h, g, g1, {0, 0}, q1, p1, q2, p2, 0.04], 
ld2[
          g1, h, 0.015], ld2[g, h, 0.015], 
        l2[{0, 0}, h, {1, 1}, {1, 0}], 
l2[g1, {1, 1}, 
          g], 
lda2[{0.5, 1.1}, {0.5, -0.1}, 0.02, 
          0.02], 
ld2[h, q1, 0.01], 
ld2[
          h, p1, 0.01], 
ld2[h, q2, 
          0.01], 
ld2[h, p2, 
          0.01], 
bogen2Grad[h, h - (h - g1) 0.2, 
          90], 
bogen2Grad[h, h - (h - p1) 0.4, 
          90], 
bogen2Grad[h, h - (h - p2) 0.6, 90], 
        text2H["FP1", g, 2], 
        text2H["FP2", g1, 3.5], 
text2H["q1", 
          q1, -2], 
        text2H["-1/q1", p1, -2], 
text2H["q2", 
          q2, -2], 
        text2H["-1/q2", 
          p2, -2], 
text2H["(0,0)", {0, 
            0}, -2], 
        text2H["(1,1)", {1, 1}, 
          2], 
DisplayFunction -> $DisplayFunction, 
        PlotRange -> All];

tP1 = 
        Table[{{n, 0}, {n, 8}}, {n, 0, 8}];
tP2 = Table[{{0, n}, {8, n}}, {n, 0, 8}]; 
    tP = Flatten[Table[{n, m}, {n, 0, 8}, {m, 0, 8}], 1]; 
    Show[l2Ser[tP1], l2Ser[tP2], po2[tP, 0.04], 
      DisplayFunction -> $DisplayFunction] ;

tP = 
        Flatten[Table[
            n {1/2,  Sqrt[3]/2} + m {1, 0}, {n, 0, 8}, {m, 0, 16}], 
          1];
tP1 = 
        Table[{n {1, 0}, 8 {1/2,  Sqrt[3]/2} + n {1, 0}}, {n, 0, 
            16}];
tP2 = 
      Table[{n {1, 0}, 8 {-1/2,  Sqrt[3]/2} + n {1, 0}}, {n, 0, 16}]; 
    tP3 = Table[{{0, n  Sqrt[3]/2}, {16, n  Sqrt[3]/2}}, {n, 0, 8}]; 
    Show[l2Ser[tP1], l2Ser[tP2], l2Ser[tP3], po2[tP, 0.015], 
      DisplayFunction -> $DisplayFunction] ;

sechs[
          kVec_] := {
kVec + {1/2,  
              Sqrt[3]/2}, 
kVec - {1/2,  
              Sqrt[3]/2}, 
kVec + {-1/2,  
              Sqrt[3]/2}, 
kVec - {-1/2,  
              Sqrt[3]/2}, 
kVec + {1, 0},  
          kVec - {1, 0}, 
kVec + {1/2,  
              Sqrt[3]/2}};
pSechs[kVec_] := 
        Join[Map[Point, 
            sechs[kVec]], {Line[sechs[kVec]]}];
tabpSechs[pS_] := 
        Join[{PointSize[pS]}, 
          Flatten[Table[
              pSechs[{0, n Sqrt[3]} + m {3/2, Sqrt[3]/2}], {n, 0, 8}, {m, 0, 
                8}], 2]];
tabpSechs[0.02];
Show[Graphics[tabpSechs[0.02]], PlotRange -> All, 
      AspectRatio -> Automatic]

sechs[kVec_] := {
 
          kVec - {1, 0}, 
kVec + {-1/2,  
              Sqrt[3]/2}, 
kVec + {1/2,  
              Sqrt[3]/2}, 
kVec + {1, 
              0}, 
kVec - {-1/2,  
              Sqrt[3]/2}, 
kVec - {1/2,  
              Sqrt[3]/2}, 
kVec - {1, 
              0}};
pSechs[kVec_] := 
        Join[Map[Point, 
            sechs[kVec]], {Line[sechs[kVec]]}];
tabpSechs[pS_] := 
        Join[{PointSize[pS]}, 
          Flatten[Table[
              pSechs[{0, n Sqrt[3]} + m {3/2, Sqrt[3]/2}], {n, 0, 8}, {m, 0, 
                8}], 2]];
tabpSechs[0.02];
Show[Graphics[tabpSechs[0.02]], PlotRange -> All, 
        AspectRatio -> Automatic];

swiss[kVec_] := {
 
          kVec + {1, 0}, 
kVec + {2, 
              0}, 
kVec + {2, 
              1}, 
kVec + {3, 
              1}, 
kVec + {3, 
              2}, 
kVec + {2, 
              2}, 
kVec + {2, 
              3}, 
kVec + {1, 
              3}, 
kVec + {1, 
              2}, 
kVec + {0, 
              2}, 
kVec + {0, 
              1}, 
kVec + {1, 
              1}, 
kVec + {1, 
              0}
};
pSwiss[kVec_] := 
        Join[Map[Point, 
            swiss[kVec]], {Line[swiss[kVec]]}];
tabpSwiss[pS_] := 
        Join[{PointSize[pS]}, 
          Flatten[Table[pSwiss[n {1, 2} + m {3, 1}], {n, 0, 12}, {m, 0, 8}], 
            2]];
tabpSwiss[0.01];
Show[Graphics[tabpSwiss[0.01]], PlotRange -> All, 
        AspectRatio -> Automatic];

swiss[kVec_] := {
 
          kVec + {1, 0}, 
kVec + {2, 
              0}, 
kVec + {2, 
              1}, 
kVec + {3, 
              1}, 
kVec + {3, 
              2}, 
kVec + {2, 
              2}, 
kVec + {2, 
              3}, 
kVec + {1, 
              3}, 
kVec + {1, 
              2}, 
kVec + {0, 
              2}, 
kVec + {0, 
              1}, 
kVec + {1, 
              1}, 
kVec + {1, 
              0}
};
li = {Line[{{8, 7}, {10, 6}, {11, 8}, {9, 9}, {8, 
                7}}]};
pSwiss[kVec_] := 
        Join[Map[Point, 
            swiss[kVec]], {Line[swiss[kVec]]}];
tabpSwiss[pS_] := 
        Join[Join[{PointSize[pS]}, 
            Flatten[Table[pSwiss[n {1, 2} + m {3, 1}], {n, 0, 4}, {m, 0, 3}], 
              2]], li];
tabpSwiss[0.01];
Show[Graphics[tabpSwiss[0.02]], text2H["Kachel", {9.5, 7.5}, 0], 
        PlotRange -> All, AspectRatio -> Automatic];