Geometrie mit Zirkel und Lineal

Inhalt

1. Putzmaschine
2. Spell Off
3. Vektorlänge
4. Senkrechter ebener Vektor
5. Liste machen
6. Minimum und Maximum von Koordinaten einer Punktmenge
7. Linienzug oder Serie von Linien zeichnen
8. Linie der Dicke d zeichnen
9. Linie mit Dashing zeichnen
10. Linie mit Dicke d und Dashing zeichnen
11. Kartesisches Achsenkreuz über einer Punktmenge zeichnen
12. Dicke Punkte zeichnen
13. Translation
14. Spiegelung an einem Punkt
15. Spiegelung an einer Ebene
16. Spiegelung an einer Geraden
17. Text an Punkt angelehnt
18. Kreise zeichnen
19. Bögen zeichnen
20. Ellipse zeichnen
21. Figurenkonstruktion zeichnen
22. Drehung von Punkt um andern Punkt bei gegebenem Winkel in Grad
23. Skizze Drehung von Punkt um andern Punkt bei gegebenem Winkel in Grad
24. Schnitt von Kreisen
25. Schnitt von Geraden
26. Schnitt von Gerade mit Kreis
27. Mittelpunkt einer Strecke
28. Mittelsenkrechte zu zwei Punkten
29. Winkelhalbierende zu drei Punkten
30. Lotfusspunkt oder rechter Winkel an Gerade
31. Spiegelung an Gerade
32. Punkt auf Gerade von einem Punkt aus unter einem Winkel in Grad gesehen
33. Eine Militärperspektive:2D aus 3D
34. Kartesisches Achsenkreuz über einer Punktmenge in 3D zeichnen
35. Pfeile
36. Beispiele Pfeile u.s.w.
    Einige Tests und Anwendungen

Programme (alle laufen lassen ==> Demos werden erzeugt)

Testversionen von Programmen.

Dieses File enthält Funktionen und Module (von Rolf Wirz, Testversionen mit einfachen Mathematica-Mitteln - einfachheit auf Kosten des Umfanges!). Die Ausführung geschieht im File "GeoSchnittAbstandWorkFile.nb", wo sich die Programmaufrufe befinden!
Erst Run machen mit diesem File (Source-Code), dann Programme ausführen in "GeoSchnittAbstandWorkFile.nb"

1. Putzmaschine

Remove["Global`*"];

2. Spell Off

Off[ ];
Off[General::spell];
Off[General::spell1];

Demo

3. Vektorlänge

vLen[v_] := Sqrt[v . v];

Demo

vLen[{3, 4}]

4. Senkrechter ebener Vektor

vSenkrEben[v_] := {-v[[2]], v[[1]]};

Demo

vSenkrEben[{3, 4}]

5. Liste machen

list2[p__] := {p};

Demo

p1 = {1, 2}; p2 = {3, -2}; p3 = {2, 1}; p4 = {5, 2}; 
    p5 = {2, 6};
list2[p1, p2, p3, p4, p5]

6. Minimum und Maximum von Koordinaten einer Punktmenge

maXx[p__] := 
        Max[Table[{p}[[n]][[1]], {n, 1, 
              Length[{p}]}]];
miNx[p__] := 
        Min[Table[{p}[[n]][[1]], {n, 1, 
              Length[{p}]}]];
maXy[p__] := 
        Max[Table[{p}[[n]][[2]], {n, 1, 
              Length[{p}]}]];
miNy[p__] := 
        Min[Table[{p}[[n]][[2]], {n, 1, 
              Length[{p}]}]];
maXxN[p__] := 
        Max[Join[
            Table[{p}[[n]][[1]], {n, 1, 
                Length[{p}]}], {0}]];
miNxN[p__] := 
        Min[Join[
            Table[{p}[[n]][[1]], {n, 1, 
                Length[{p}]}], {0}]];
maXyN[p__] := 
        Max[Join[
            Table[{p}[[n]][[2]], {n, 1, 
                Length[{p}]}], {0}]];
miNyN[p__] := 
        Min[Join[
            Table[{p}[[n]][[2]], {n, 1, 
                Length[{p}]}], {0}]];

Demo

p1 = {1, 2}; p2 = {3, -2}; p3 = {2, 1}; p4 = {5, 2}; 
    p5 = {2, 6};

maXx[p1, p2, p3, p4, p5]

miNx[p1, p2, p3, p4, p5]

maXy[p1, p2, p3, p4, p5]

miNy[p1, p2, p3, p4, p5]

{{miNx[p1, p2, p3, p4], maXx[p1, p2, p3, p4]}, {miNy[p1, p2, p3, p4], 
        maXy[p1, p2, p3, p4]}}

maXxN[p1, p2, p3, p4, p5]

miNxN[p1, p2, p3, p4, p5]

maXyN[p1, p2, p3, p4, p5]

miNyN[p1, p2, p3, p4, p5]

7. Linienzug oder Linienserie zeichnen

l2[p__] := 
        Show[Graphics[Line[{p}]], PlotRange -> All, 
          AspectRatio -> Automatic, 
          DisplayFunction -> Identity];
l2[{p__}] := l2[p];

l2Ser[pSer__] := 
        Show[Graphics[{Map[Line, pSer]}], PlotRange -> All, 
          AspectRatio -> Automatic, 
          DisplayFunction -> Identity];

Demo

p1 = {1, 2}; p2 = {3, -2}; p3 = {2, 1}; p4 = {5, 2}; 
    p5 = {2, 6};
Show[l2[p1, p2, p3, p4, p5], 
        DisplayFunction -> $DisplayFunction];

p1 = {1, 2}; p2 = {3, -2}; p3 = {2, 1}; p4 = {5, 2}; 
    p5 = {2, 6};
Show[l2[{p1, p2, p3, p4, p5}], 
        DisplayFunction -> $DisplayFunction];

tP1 = 
        Table[{{n, 0}, {n, 8}}, {n, 0, 8}];
tP2 = 
        Table[{{0, n}, {8, n}}, {n, 0, 8}];
Show[l2Ser[tP1], l2Ser[tP2], 
        DisplayFunction -> $DisplayFunction];

8. Linie der Dicke d zeichnen

ld2[p1_, p2_, d_] := 
        ParametricPlot[p1 + t (p2 - p1), {t, 0, 1}, 
          PlotRange -> All, AspectRatio -> Automatic, 
          PlotStyle -> {Thickness[d]}, Axes -> None, 
          DisplayFunction -> Identity];
ld2[{p1_, p2_}, d_] := ld2[p1, p2, d];

Demo

Show[ld2[{1, 2}, {3, -2}, 0.04], 
        DisplayFunction -> $DisplayFunction];

9. Linie mit Dashing zeichnen

lda2[p1_, p2_, da1_, da2_] := 
        ParametricPlot[p1 + t (p2 - p1), {t, 0, 1}, 
          PlotRange -> All, AspectRatio -> Automatic, 
          PlotStyle -> {Dashing[{da1, da2}]}, Axes -> None, 
          DisplayFunction -> Identity];
lda2[{p1_, p2_}, da1_, da2_] := lda2[p1, p2, da1, da2];

Demo

Show[lda2[{1, 2}, {3, -2}, 0.2, 0.4], 
        DisplayFunction -> $DisplayFunction];

10. Linie mit Dicke d und Dashing zeichnen

lDda2[p1_, p2_, d_, da1_, da2_] := 
        ParametricPlot[p1 + t (p2 - p1), {t, 0, 1}, 
          PlotRange -> All, AspectRatio -> Automatic, 
          PlotStyle -> {Thickness[d], Dashing[{da1, da2}]}, 
          Axes -> None, 
          DisplayFunction -> Identity];
lDda2[{p1_, p2_}, d_, da1_, da2_] := 
        lDda2[p1, p2, d, da1, da2];

Demo

Show[lDda2[{1, 2}, {3, -2}, 0.1, 0.2, 0.4], 
        DisplayFunction -> $DisplayFunction];

11. Kartesisches Achsenkreuz über einer Punktmenge zeichnen

kartKreuz2[p__] := 
        Show[Graphics[{Line[{{miNxN[p], 0}, {maXxN[p], 0}}], 
              Line[{{0, miNyN[p]}, {0, maXyN[p]}}]}], PlotRange -> All, 
          AspectRatio -> Automatic, 
          DisplayFunction -> Identity];
kartKreuz2[{p__}] := kartKreuz2[p];

Demo

p1 = {1, 2}; p2 = {3, -2}; p3 = {-1, 1}; p4 = {5, 2}; 
    p5 = {2, 6};
d = 0.02;  da1 = 0.05; da2 = 0.03;
Show[kartKreuz2[p1, p2, p3, p4, p5], 
        DisplayFunction -> $DisplayFunction, 
        PlotRange -> All];

Demo Kombination mitGraphikobjekt lDda2

p1 = {1, 2}; p2 = {3, -2}; p3 = {-1, 1}; p4 = {5, 2}; 
    p5 = {2, 6};
d = 0.02;  da1 = 0.05; da2 = 0.03;
Show[lDda2[{1, 2}, {3, -2}, 0.1, 0.2, 0.4], 
        kartKreuz2[p1, p2, p3, p4, p5], 
        DisplayFunction -> $DisplayFunction, 
        PlotRange -> All];

12. Dicke Punkte zeichnen

poE2[p_, size_] := 
      Show[Graphics[{PointSize[size], Point[p]}], PlotRange -> All, 
        AspectRatio -> Automatic, DisplayFunction -> Identity]; 
    po2[p__, size_] := 
      Show[Graphics[{PointSize[size], Map[Point, {p}]}], 
        PlotRange -> All, AspectRatio -> Automatic, 
        DisplayFunction -> Identity];
po2[{p__}, size_] := po2[p, size];

Demo

Show[poE2[{1, 2}, 0.1], 
      DisplayFunction -> $DisplayFunction]

Show[po2[{1, 2}, {4, 3}, {-1, -1}, 0.07], 
      DisplayFunction -> $DisplayFunction]

Show[po2[{{1, 2}, {4, 3}, {-1, -1}}, 0.07], 
      DisplayFunction -> $DisplayFunction]

13. Translation

transL2[p__, p0_] := 
        Table[{p}[[n]] + p0, {n, 1, 
            Length[{p}]}];
transL2[{p__}, p0_] := transL2[p, p0];

Demo

transL2[{1, 2}, {4, 3}, {1, 2}]

transL2[{{1, 2}, {4, 3}, {-1, -1}}, {1, 2}]

14. Spiegelung Punkt an Punkt oder Punktmenge an Punkt

spiegPu2[p_, p0_] := - p + 2 p0 ; 
    spiegPuMenge2[p__, p0_] := 
      Table[spiegPu2[list2[p][[n]], p0], {n, 1, Length[list2[p]]}]; 
    spiegPuMenge2[{p__}, p0_] := 
      Table[spiegPu2[list2[p][[n]], p0], {n, 1, 
          Length[list2[p]]}];

Demo

spiegPu2[{1, 2}, {0, 0}]

spiegPuMenge2[{{1, 2}, {4, 3}, {-1, -1}}, {0, 0}]

spiegPuMenge2[{1, 2}, {4, 3}, {-1, -1}, {0, 0}]

15. Spiegelung Punkt an Punkt Ebene

spiegelEb[p1_,p2_,p3_,q1_]:=q1-2 Det[{p2-p1,p3-p1,q1-p1}]/Det[{p2-p1,p3-p1,Cross[p2-p1,p3-p1]}] Cross[p2-p1,p3-p1];

Demo

p1={0,0,4};p2={0,6,0};p3={3,0,0};q1={2,8,0};
q2 = spiegelEb[p1,p2,p3,q1]

16. Spiegelung Punkt an Gerade

spiegelGe[p1_,p2_,q1_]:=q1-2 Det[{p2-p1,q1-p1}]/((p2-p1).(p2-p1)) vSenkrEben[p2-p1];

Demo

p1={0,4};p2={6,0};q1={2,8};
q2 = spiegelGe[p1,p2,q1]

17. Text an Punkt angelehnt

text2L[wort_, p_, distanz_] := 
        Show[Graphics[{Text[wort, p, {distanz, 0}], {PointSize[ .075], 
                RGBColor[1, 0, 0], Point[p]}}, PlotRange -> All, 
            AspectRatio -> Automatic, 
            DisplayFunction -> Identity]];
text2R[wort_, p_, distanz_] := 
        Show[Graphics[{Text[wort, p, {-distanz, 0}], {PointSize[ .075], 
                RGBColor[1, 0, 0], Point[p]}}, PlotRange -> All, 
            AspectRatio -> Automatic, 
            DisplayFunction -> Identity]];
text2H[wort_, p_, distanz_] := 
        Show[Graphics[{Text[wort, p, {0, -distanz}], {PointSize[ .075], 
                RGBColor[1, 0, 0], Point[p]}}, PlotRange -> All, 
            AspectRatio -> Automatic, 
            DisplayFunction -> Identity]];
text2T[wort_, p_, distanz_] := 
        Show[Graphics[{Text[wort, p, {0, distanz}], {PointSize[ .075], 
                RGBColor[1, 0, 0], Point[p]}}, PlotRange -> All, 
            AspectRatio -> Automatic, 
            DisplayFunction -> Identity]];
text2[wort_, p_, distanzH_, distanzV_, richtungH_, richtungV_] := 
        Show[Graphics[{Text[
                StyleForm[wort, FontSize -> 14, 
                  FontWeight -> "Bold"], 
                p, {distanzH, distanzV}, {richtungH, richtungV}]}],  
          If[var1Stop2Never3Use == 9,  Frame -> True, 
            Frame -> False], PlotRange -> All, 
          AspectRatio -> Automatic, 
          DisplayFunction -> Identity];

Demo

text2L["hallo", {2, 1}, 5]

text2R["hallo", {2, 1}, 5]

text2H["hallo", {2, 1}, 5]

text2T["hallo", {2, 1}, 5]

var1Stop2Never3Use = 9;
Show[text2["hallo", {2, 3}, 1, 1, 1, 2], 
        DisplayFunction -> $DisplayFunction];

var1Stop2Never3Use = 1;
Show[text2["hallo", {2, 3}, 1, 1, 1, 2], 
        DisplayFunction -> $DisplayFunction];

18. Kreise zeichnen

kreis2[pM_, r_] := 
        Show[Graphics[Circle[pM, r]], PlotRange -> All, 
          AspectRatio -> Automatic, 
          DisplayFunction -> Identity];

Demo

Show[kreis2[{2, 3}, 2], AspectRatio -> Automatic, 
      DisplayFunction -> $DisplayFunction]

19. Bögen zeichnen

bogen2Grad[pM_, p_, α_] := 
        ParametricPlot[
          vLen[p - pM] *{Cos[t], Sin[t]} + pM, {t, 
            u = Evaluate[
                If[(p - pM)[[2]] >= 
                    0, 
ArcCos[((p - pM)[[1]])/
                      Sqrt[((p - pM)[[1]])^2 + ((p - 
                                    pM)[[2]])^2]], 
ArcCos[-((p - pM)[[1]])/
                        Sqrt[((p - pM)[[1]])^2 + ((p - 
                                      pM)[[2]])^2]] + Pi]], 
            u + α Degree}, PlotRange -> All, 
          AspectRatio -> Automatic, Axes -> None, 
          DisplayFunction -> Identity];

Demo

Show[bogen2Grad[{2, 3}, {4, 5}, 30], AspectRatio -> Automatic, 
      DisplayFunction -> $DisplayFunction]

20. Ellipse zeichnen

ellipse2[pM_, a_, b_, α_] := 
        ParametricPlot[{{Cos[α Degree], -Sin[α Degree]}, {Sin[α Degree], Cos[α Degree]}} . {a Cos[t], b Sin[t]} + 
            pM, {t, 0, 2 Pi}, PlotRange -> All, 
          AspectRatio -> Automatic, Axes -> None, 
          DisplayFunction -> Identity];
ellipse2dick[pM_, a_, b_, α_, d_, da1_, da2_] := 
        ParametricPlot[{{Cos[α Degree], -Sin[α Degree]}, {Sin[α Degree], Cos[α Degree]}} . {a Cos[t], b Sin[t]} + 
            pM, {t, 0, 2 Pi}, 
          PlotStyle -> {Thickness[d], Dashing[{da1, da2}]}, 
          PlotRange -> All, AspectRatio -> Automatic, 
          Axes -> None, DisplayFunction -> Identity];

Demo

Show[ellipse2[{1, 2}, 4, 3, 30], 
      DisplayFunction -> $DisplayFunction]

Show[ellipse2dick[{1, 2}, 4, 3, 30, 0.04, 0.2, 0.3], 
      DisplayFunction -> $DisplayFunction]

21. Figurenkonstruktion zeichnen

dreieck2[qI1_, qI2_, size_] := 
        Module[
{punktDreieck,  pI1,  
            pI2}, 
Off[General::spell]; 
          punktDreieck[pI1_, 
              pI2_] := ({{Cos[Pi/3], -Sin[Pi/3]}, {Sin[Pi/3], 
                      Cos[Pi/3]}} . (pI2 - pI1)) + 
              pI1; 
Show[
            Graphics[{PointSize[size], Point[punktDreieck[qI1, qI2]], 
                Line[{qI1, qI2, punktDreieck[qI1, qI2], qI1}]}], 
            PlotRange -> All, AspectRatio -> Automatic, 
            DisplayFunction -> Identity]  ];

Demo

Show[dreieck2[{1, -1}, {4, 2}, 0.02], 
      DisplayFunction -> $DisplayFunction]

22. Drehung von Punkt um andern Punkt bei gegebenem Winkel in Grad

drehPunkt2[qI1_, qI2_, alpha_] := 
        Module[
{punkt}, 
Off[
            General::spell]; 
          punkt[pI1_, 
              pI2_, φ_] := ({{Cos[φ Degree], -Sin[φ Degree]}, {Sin[φ Degree], 
                      Cos[φ Degree]}} . (pI2 - pI1)) + 
              pI1; 
punkt[qI1, qI2, alpha] ];

Demo

drehPunkt2[{0, 0}, {1, 0}, 60]

23. Skizze Drehung von Punkt um andern Punkt bei gegebenem Winkel in Grad

drehPunktSkizze2[qI1_, qI2_, alpha_] := 
        Module[
{punkt}, 
Off[
            General::spell]; 
          punkt[pI1_, 
              pI2_, φ_] := ({{Cos[φ Degree], -Sin[φ Degree]}, {Sin[φ Degree], 
                      Cos[φ Degree]}} . (pI2 - pI1)) + 
              pI1; 
Show[
            Graphics[{PointSize[0.03], Point[punkt[qI1, qI2, alpha]], 
                Line[{punkt[qI1, qI2, alpha], qI1, qI2}]}], 
            AspectRatio -> Automatic, 
            DisplayFunction -> Identity]];

Demo

Show[drehPunktSkizze2[{2, 3}, {3, 4}, 30], 
      DisplayFunction -> $DisplayFunction]

24. Schnitt von Kreisen

kreisSchnitt2[pm1_, rk1_, pm2_, rk2_] := 
        Module[{kreis, mVec, xVec, x, y, rkI}, 
          Off[General::spell]; 
xVec[x_, y_] := {x, 
              y}; 
kreis[mVec_, 
              rkI_] := (xVec[x, y] - mVec) . (xVec[x, y] - mVec) - 
              rkI^2; 
solv = 
            Solve[{kreis[pm1, rk1] == 0,  
                kreis[pm2, rk2] == 0}, {x, 
                y}]; 
pSchnitt1 = {x, y} /. 
              solv[[1]]; 
pSchnitt2 = {x, y} /. 
              solv[[2]]; 
{ pSchnitt1,  
            pSchnitt2}
];

Demo

kreisSchnitt2[{2, 1}, 5, {3, -1}, 4]

25. Schnitt von Geraden

gerade2Schnitt2[ pG1_, pG2_,  qG1_, qG2_] := 
        Module[{gerade, λ, μ, pGI1, 
            pGI2, λSchnitt, μSchnitt, pSchnitt1, 
            pSchnitt2}, 
Off[
            General::spell]; 
gerade[λ_, pGI1_, 
              pGI2_] := pGI1 + λ (pGI2 - 
                    pGI1); 
solv = 
            Flatten[Solve[{
gerade[λ, pG1, 
                      pG2] ==  gerade[μ, qG1, 
                      qG2]}, {λ, μ}]]; 
λSchnitt = λ /. 
              solv[[1]]; 
μSchnitt = μ /. 
              solv[[2]]; 
pSchnitt1 = 
            gerade[λSchnitt, pG1, 
              pG2]; 
pSchnitt2 = 
            gerade[μSchnitt, qG1, 
              qG2]; 
pSchnitt1
];

Demo

gerade2Schnitt2[ {1, 0}, {-1, 0}, {0, 1}, {0, -1}]

26. Schnitt von Gerade mit Kreis

geradeKreisSchnitt2[ pG1_, pG2_, pm_, r_] := 
        Module[{gerade, λ, μ, pGI1, pGI2, kreis, mVec, xVec, x, 
            y, rkI}, 
Off[
            General::spell]; 
gerade[λ_, pGI1_, 
              pGI2_] := pGI1 + λ (pGI2 - 
                    pGI1); 
xVec[x_, y_] := {x, 
              y}; 
kreis[vec_, mVec_, 
              rkI_] := (vec - mVec) . (vec - mVec) - 
              rkI^2; 
solv = 
            Flatten[Solve[
kreis[{gerade[λ, pG1, 
                          pG2][[1]], gerade[λ, pG1, 
                          pG2][[2]]}, pm, r] == 
                  0, 
{λ}]]; 
λSchnitt1 = λ /. 
              solv[[1]]; 
λSchnitt2 = λ /. solv[[2]]; 
pSchnitt1 = 
            gerade[λSchnitt1, pG1, 
              pG2]; 
pSchnitt2 = 
            gerade[λSchnitt2, pG1, 
              pG2]; 
{pSchnitt1, 
            pSchnitt2}
];

Demo

geradeKreisSchnitt2[{2, 1}, {3, 5}, {7, 6}, 11] // N

27. Mittelpunkt einer Strecke

mittelpunktStrecke2[ pG1_, 
          pG2_] := 
Module[
{mP}, 
Off[
            General::spell1]; 
mP = (pG1 + pG2)/
              2; 
mP
];

Demo

mittelpunktStrecke2[ {3, 5}, {4, 6}]

28. Mittelsenkrechte zu zwei Punkten

mittelsenkrechte2[ pG1_, 
          pG2_] := 
Module[
{hP1, hP2, 
            punkt, qI1, qI2, φ}, 
Off[
            General::spell]; 
punkt[pI1_, 
              pI2_, φ_] := ({{Cos[φ Degree], -Sin[φ Degree]}, {Sin[φ Degree], 
                      Cos[φ Degree]}} . (pI2 - pI1)) + 
              pI1; 
hP1 = 
            punkt[( pG1 + pG2)/2, pG2, 90]; 
hP2 = 
            punkt[( pG1 + pG2)/2, pG2, -90]; 
{ 
            hP1, hP2}
];

Demo

mittelsenkrechte2[ {3, 5}, {4, 6}]

29. Winkelhalbierende zu drei Punkten

winkelhalbierende2[pO_ , pG1_, 
          pG2_] := 
Module[
{vLen, 
            hW}, 
Off[
            General::spell]; 
vLen[v_] := 
            Sqrt[v . v]; 
hW = 
            pO + (pG1 - pO) 1/vLen[(pG1 - pO)] + (pG2 - pO) 1/
                  vLen[(pG2 - pO)]; 
If[
            Det[{pO - pG1, p0 - pG2}] == 0,  
            hW = {(-pO + pG1)[[2]], (pO - 
                      pG1)[[1]]}];  
{ pO, 
            hW}
];

Demo

winkelhalbierende2[{2, 1}, {3, 5}, {7, 6}]

30. Lotfusspunkt oder rechter Winkel an Gerade

lotFussPunktGerade2[pG1_, pG2_, 
          pQ_] := 
Module[
{g1, 
            g2, λ, punkt, pI1, pI2, φ, pQ1, solv, pL1, 
            pL2}, 
Off[
            General::spell]; 
g1[λ_] := 
            pG1 +  λ (pG2 - pG1); 
punkt[
              pI1_, pI2_, φ_] := ({{Cos[φ Degree], -Sin[φ Degree]}, {Sin[φ Degree], 
                      Cos[φ Degree]}} . (pI2 - pI1)) + 
              pI1; 
pQ1 = 
            punkt[pG1, pG2, 90]; 
g2[μ_] := 
            pQ + μ (pQ1 - pG1); 
solv = 
            Flatten[Solve[
                g1[λ] == 
                  g2[μ], {λ, μ}]]; 
pL1 = 
            g1[λ] /. {solv[[1]]}; 
pL2 = 
            g2[μ] /. {solv[[2]]}; 
pL1
];

Demo

lotFussPunktGerade2[{2, 1}, {3, 5}, {7, 6}]

q1 = {2, 1};  q2 = {3, 5};  q3 = {7, 6}; 

    q4 = lotFussPunktGerade2[{2, 1}, {3, 5}, {7, 6}];

    Show[po2[q1, q2, q3, q4, 0.07], l2[q1, q2] , 
      DisplayFunction -> $DisplayFunction]

Show[po2[q1, q2, q3, q4, 0.07], l2[q1, q4] , l2[q3, q4] , 
      DisplayFunction -> $DisplayFunction]

31. Spiegelung an Gerade

spiegelungPunktAnGeraden[pG1_, pG2_, 
          pQ_] := 
Module[
{g1, 
            g2, λ, punkt, pI1, pI2, φ, pQ1, solv, pL1, pL2, 
            spiegPu2Int}, 
Off[
            General::spell]; 
spiegPu2Int[p_, 
              p0_] := - p + 2 p0 ; 
g1[λ_] := 
            pG1 +  λ (pG2 - pG1); 
punkt[
              pI1_, pI2_, φ_] := ({{Cos[φ Degree], -Sin[φ Degree]}, {Sin[φ Degree], 
                      Cos[φ Degree]}} . (pI2 - pI1)) + 
              pI1; 
pQ1 = 
            punkt[pG1, pG2, 90]; 
g2[μ_] := 
            pQ + μ (pQ1 - pG1); 
solv = 
            Flatten[Solve[
                g1[λ] == 
                  g2[μ], {λ, μ}]]; 
pL1 = 
            g1[λ] /. {solv[[1]]}; 
pL2 = 
            g2[μ] /. {solv[[2]]}; 
spiegPu2Int[pQ, 
            pL1]
];

Demo

spiegelungPunktAnGeraden[{2, 1}, {3, 5}, {7, 6}]

32. Punkt auf Gerade von einem Punkt aus unter einem Winkel in Grad gesehen

winkelFussPunktGerade2[pG1_, pG2_, 
          pQ_, α_] := 
Module[
{g, λ, v, v1, v2, vLen, solv, pL, alpha}, 
Off[
            General::spell]; 
vLen[v_] := 
            Sqrt[v . v]; 
g[λ_] := 
            pG1 +  λ (pG2 - 
                    pG1); 
v1[λ_] := 
            g[λ] - pQ; 
v2 = 
            pG2 - pG1; 
alpha = 
            2 Pi α  /360 ; 
solv = 
            Flatten[Solve[
                Cos[alpha]^2 == ((v1[λ] . 
                            v2)/(vLen[v1[λ]]  vLen[
                              v2]))^2, {λ}]]; 
pL1 = 
            g[λ] /. solv[[1]]; 
pL2 = 
            g[λ] /. solv[[2]]; 
{pL1, 
            pL2}
];

Demo

winkelFussPunktGerade2[{2, 1}, {3, 5}, {7, 6}, 30] // N

33. Eine Militärperspektive: 2D aus 3D

pu2D[pu3D_] := {pu3D[[1]], pu3D[[3]]} + 
          pu3D[[2]]/2 {Sqrt[3]/2, 1/2};

Demo

pu = {1, 2, 3};
pu2D[pu]

34. Kartesisches Achsenkreuz über einer Punktmenge in 3D zeichnen

kartKreuz3[p__] := 
        Show[Graphics[{Line[{{miNxN[p], 0}, {maXxN[p], 0}}], 
              Line[{{0, miNyN[p]}, {0, maXyN[p]}}], 
              li = Line[{-{Sqrt[3]/2, 1/2}*miNxN[p], {Sqrt[3]/2, 1/2}*
                      maXxN[p]}]}], PlotRange -> All, 
          AspectRatio -> Automatic, 
          DisplayFunction -> Identity];
kartKreuz3[{p__}] := kartKreuz3[p];
kartKreuz3[p__] := 
        Show[Graphics[{Line[{{miNxN[p], 0}, {maXxN[p], 0}}], 
              Line[{{0, miNyN[p]}, {0, maXyN[p]}}], 
              Line[{- maXxN[p]*{Sqrt[3]/2, 1/2},  
                  maXxN[p]*{Sqrt[3]/2, 1/2}}]}], 
          AspectRatio -> Automatic, 
          DisplayFunction -> Identity];
kartKreuz3[{p__}] := kartKreuz3[p];

Demo

Show[
      kartKreuz3[{2, 1}, {3, 5}, {7, 6}, {-2, -2}, {-3, 
          5}, {-7, 6}], 
      DisplayFunction -> $DisplayFunction]

35. Pfeile

<< Graphics`Arrow`

arrAbs[p1_, p2_] := 
        Show[Graphics[{Arrow[p1, p2, HeadScaling -> Absolute]}], 
          PlotRange -> All, AspectRatio -> Automatic, 
          DisplayFunction -> Identity];
arrRel[p1_, p2_] := 
        Show[Graphics[{Arrow[p1, p2, HeadScaling -> Relative]}], 
          PlotRange -> All, AspectRatio -> Automatic, 
          DisplayFunction -> Identity];

Demo

Show[arrAbs[{2, 1}, {3, 5}], PlotRange -> All, 
        DisplayFunction -> $DisplayFunction];
Show[arrRel[{2, 1}, {3, 5}], PlotRange -> All, 
        DisplayFunction -> $DisplayFunction];

36. Beispiele Pfeile und Anwendung u.s.w.

Demo

<< Graphics`Arrow`

Plot[Sin[x], {x, 0, 2  Pi}, 
        Epilog -> {Arrow[{4,  .25}, {Pi/2, 1}], 
            Text["Here", {4,  .15}, {0, -1}]}];
Show[
        Graphics[
          Table[Arrow[{0, 0}, x {Sin[x], Cos[x]}, 
              HeadScaling -> Relative], {x, 0, 2 Pi,  .3}]], 
        PlotRange -> All];
Show[
        Graphics[
          Table[Arrow[{0, 0}, x {Sin[x], Cos[x]}, 
              HeadScaling -> Absolute], {x, 0, 2 Pi,  .3}]], 
        PlotRange -> All];
Show[
        Graphics[
          Table[Arrow[{0, 0}, {Sin[x], Cos[x]}, HeadCenter -> x, 
              HeadLength ->  .1], {x, 0, 1.6,  .2}]], 
        PlotRange -> {{- .1, 1}, {- .2, 1.1}}, 
        AspectRatio -> Automatic];
Show[
        Graphics[{Arrow[{0, 1}, {1, 0}, HeadScaling -> Relative, 
              HeadShape -> {Polygon[{{0, 
                        0}, {- .2,  .05}, {- .2, - .05}}], 
                  Polygon[{{-1, 
                        0}, {- .8,  .05}, {- .8, - .05}}]}], 
            Arrow[{ .25,  .25}, { .75,  .75}, 
              HeadShape -> {Line[{{ .1,  .1}, {- .1, - .1}}], 
                  Line[{{ .1, - .1}, {- .1,  .1}}]}]}, 
          PlotRange -> All]];
Show[
      Graphics[{GrayLevel[0.5], 
          Polygon[{{-1, 
                0}, {- .8,  .05}, {- .8, - .05}}]}]]

Eigene 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];

Das Programm "initGeo": Hier laufen lassen und dann in andern Files abrufbar!
Achtung: In einen Modul eingepackt wirken die Show-Befehle nicht

1. Putzmaschine,  Spell Off

\(\(\( (*\ \ 1\ *) \)\(\ \ \)\(
\)\(\(Remove["Global`*"];\)
 (*\ \ 2\ *) \ \ 

    \(Off[\ ];\)

    \(Off[General::spell];\)

    \(Off[General::spell1];\)\)\)\)

2. Geometriefunktionen

initGeo[nummer_:1]:=Module[{}, 
(*  3 *) 
vLen[v_]:=Sqrt[v.v];
(*  4 *)
vSenkrEben[v_]:={-v[[2]],v[[1]]};
(*  5 *) 
list2[p__]:={p};
(*  6 *) 
maXx[p__]:=Max[Table[{p}[[n]][[1]],{n,1,Length[{p}]}]];
miNx[p__]:=Min[Table[{p}[[n]][[1]],{n,1,Length[{p}]}]];
maXy[p__]:=Max[Table[{p}[[n]][[2]],{n,1,Length[{p}]}]];
miNy[p__]:=Min[Table[{p}[[n]][[2]],{n,1,Length[{p}]}]];
maXxN[p__]:=Max[Join[Table[{p}[[n]][[1]],{n,1,Length[{p}]}],{0}]];
miNxN[p__]:=Min[Join[Table[{p}[[n]][[1]],{n,1,Length[{p}]}],{0}]];
maXyN[p__]:=Max[Join[Table[{p}[[n]][[2]],{n,1,Length[{p}]}],{0}]];
miNyN[p__]:=Min[Join[Table[{p}[[n]][[2]],{n,1,Length[{p}]}],{0}]];
(*  7 *) 
l2[p__]:=Show[Graphics[Line[{p}]],PlotRange->All,
      AspectRatio->Automatic,DisplayFunction->Identity];
l2[{p__}]:=l2[p];
l2Ser[pSer__]:=
    Show[Graphics[{Map[Line,pSer]}],PlotRange->All,
      AspectRatio->Automatic,DisplayFunction->Identity];
(*  8 *) 
ld2[p1_,p2_,d_]:=
    ParametricPlot[p1+t(p2-p1),{t,0,1},PlotRange->All,
      AspectRatio->Automatic,PlotStyle->{Thickness[d]},
      Axes->None,DisplayFunction->Identity];
ld2[{p1_,p2_},d_]:=ld2[p1,p2,d];
(*  9 *) 
lda2[p1_,p2_,da1_,da2_]:=
    ParametricPlot[p1+t(p2-p1),{t,0,1},PlotRange->All,
      AspectRatio->Automatic,PlotStyle->{Dashing[{da1,da2}]},
      Axes->None,DisplayFunction->Identity];
lda2[{p1_,p2_},da1_,da2_]:=lda2[p1,p2,da1,da2];
(*  10 *) 
lDda2[p1_,p2_,d_,da1_,da2_]:=
    ParametricPlot[p1+t(p2-p1),{t,0,1},PlotRange->All,
      AspectRatio->Automatic,
      PlotStyle->{Thickness[d],Dashing[{da1,da2}]},Axes->None,
      DisplayFunction->Identity];
lDda2[{p1_,p2_},d_,da1_,da2_]:=lDda2[p1,p2,d,da1,da2];
(*  11 *) 
kartKreuz2[p__]:=
    Show[Graphics[{Line[{{miNxN[p],0},{maXxN[p],0}}],
          Line[{{0,miNyN[p]},{0,maXyN[p]}}]}],PlotRange->All,
      AspectRatio->Automatic,DisplayFunction->Identity];
kartKreuz2[{p__}]:=kartKreuz2[p];  
(*  12 *) 
poE2[p_,size_]:=
  Show[Graphics[{PointSize[size],Point[p]}],PlotRange->All,
    AspectRatio->Automatic,DisplayFunction->Identity];
po2[p__,size_]:=
  Show[Graphics[{PointSize[size],Map[Point,{p}]}],PlotRange->All,
    AspectRatio->Automatic,DisplayFunction->Identity];
po2[{p__},size_]:=po2[p,size]; 
(*  13 *) 
transL2[p__,p0_]:=Table[{p}[[n]]+p0,{n,1,Length[{p}]}];
transL2[{p__},p0_]:=transL2[p,p0];
(*  14 *) 
spiegPu2[p_,p0_]:=- p+2 p0 ;
spiegPuMenge2[p__,p0_]:=
  Table[spiegPu2[list2[p][[n]],p0],{n,1,Length[list2[p]]}];
spiegPuMenge2[{p__},p0_]:=
  Table[spiegPu2[list2[p][[n]],p0],{n,1,Length[list2[p]]}];
(*  15 *) 
spiegelEb[p1_,p2_,p3_,q1_]:=q1-2 Det[{p2-p1,p3-p1,q1-p1}]/Det[{p2-p1,p3-p1,Cross[p2-p1,p3-p1]}] Cross[p2-p1,p3-p1];
(*  16 *) 
spiegelGe[p1_,p2_,q1_]:=q1-2 Det[{p2-p1,q1-p1}]/((p2-p1).(p2-p1)) vSenkrEben[p2-p1];
(*  17 *) 
text2L[wort_,p_,distanz_]:=
    Show[Graphics[{Text[wort,p,{distanz,0}],{PointSize[.075],RGBColor[1,0,0],
            Point[p]}},PlotRange->All,AspectRatio->Automatic,
        DisplayFunction->Identity]];
text2R[wort_,p_,distanz_]:=
    Show[Graphics[{Text[wort,p,{-distanz,0}],{PointSize[.075],RGBColor[1,0,0],
            Point[p]}},PlotRange->All,AspectRatio->Automatic,
        DisplayFunction->Identity]];
text2H[wort_,p_,distanz_]:=
    Show[Graphics[{Text[wort,p,{0,-distanz}],{PointSize[.075],RGBColor[1,0,0],
            Point[p]}},PlotRange->All,AspectRatio->Automatic,
        DisplayFunction->Identity]];
text2T[wort_,p_,distanz_]:=
    Show[Graphics[{Text[wort,p,{0,distanz}],{PointSize[.075],RGBColor[1,0,0],
            Point[p]}},PlotRange->All,AspectRatio->Automatic,
        DisplayFunction->Identity]];
text2[wort_,p_,distanzH_,distanzV_,richtungH_,richtungV_]:=
    Show[Graphics[{Text[
            StyleForm[wort,FontSize->14,FontWeight->"Bold"],
            p,{distanzH,distanzV},{richtungH,richtungV}]}], 
      If[var1Stop2Never3Use==9, Frame->True,Frame->False],
      PlotRange->All,AspectRatio->Automatic,
      DisplayFunction->Identity];
(*  18 *) 
kreis2[pM_,r_]:=
    Show[Graphics[Circle[pM,r]],PlotRange->All,
      AspectRatio->Automatic,DisplayFunction->Identity];
(*  19 *) 
bogen2Grad[pM_,p_,α_]:=
    ParametricPlot[
      vLen[p-pM] *{Cos[t],Sin[t]}+pM,{t,u=Evaluate[If[(p-pM)[[2]]>=0,
              ArcCos[((p-pM)[[1]])/Sqrt[((p-pM)[[1]])^2+((p-pM)[[2]])^2]],
              
              ArcCos[-((p-pM)[[1]])/Sqrt[((p-pM)[[1]])^2+((p-pM)[[2]])^2]]+
                Pi]],u+α Degree},PlotRange->All,
      AspectRatio->Automatic,Axes->None,
      DisplayFunction->Identity];
(*  20 *) 
ellipse2[pM_,a_,b_,α_]:=
    ParametricPlot[{{Cos[α Degree],-Sin[α \
Degree]},{Sin[α Degree],Cos[α Degree]}}.{a Cos[t],b Sin[t]}+
        pM,{t,0,2 Pi},PlotRange->All,AspectRatio->Automatic,
      Axes->None,DisplayFunction->Identity];
ellipse2dick[pM_,a_,b_,α_,d_,da1_,da2_]:=
    ParametricPlot[{{Cos[α Degree],-Sin[α \
Degree]},{Sin[α Degree],Cos[α Degree]}}.{a Cos[t],b Sin[t]}+
        pM,{t,0,2 Pi},PlotStyle->{Thickness[d],Dashing[{da1,da2}]},
      PlotRange->All,AspectRatio->Automatic,Axes->None,
      DisplayFunction->Identity];
(*  21 *) 
dreieck2[qI1_,qI2_,size_]:=Module[
      {punktDreieck, pI1, pI2},
      Off[General::spell];
      punktDreieck[pI1_,
          pI2_]:=({{Cos[Pi/3],-Sin[Pi/3]},{Sin[Pi/3],Cos[Pi/3]}}.(pI2-pI1))+
          pI1;
      Show[
        Graphics[{PointSize[size],Point[punktDreieck[qI1,qI2]],
            Line[{qI1,qI2,punktDreieck[qI1,qI2],qI1}]}],PlotRange->All,
        AspectRatio->Automatic,DisplayFunction->Identity]  ];
(*  22 *) 
drehPunkt2[qI1_,qI2_,alpha_]:=Module[
      {punkt},
      Off[General::spell];
      punkt[pI1_,
          pI2_,φ_]:=({{Cos[φ Degree],-Sin[φ \
Degree]},{Sin[φ Degree],Cos[φ Degree]}}.(pI2-pI1))+pI1;
      punkt[qI1,qI2,alpha] ];  
(*  23 *) 
drehPunktSkizze2[qI1_,qI2_,alpha_]:=Module[
      {punkt},
      Off[General::spell];
      punkt[pI1_,
          pI2_,φ_]:=({{Cos[φ Degree],-Sin[φ \
Degree]},{Sin[φ Degree],Cos[φ Degree]}}.(pI2-pI1))+pI1;
      Show[
        Graphics[{PointSize[0.03],Point[punkt[qI1,qI2,alpha]],
            Line[{punkt[qI1,qI2,alpha],qI1,qI2}]}],
        AspectRatio->Automatic,DisplayFunction->Identity]];  
(*  24 *) 
kreisSchnitt2[pm1_,rk1_,pm2_,rk2_]:=
    Module[{kreis,mVec,xVec,x,y,rkI},Off[General::spell];
      xVec[x_,y_]:={x,y};
      kreis[mVec_,rkI_]:=(xVec[x,y]-mVec).(xVec[x,y]-mVec)-rkI^2;
      solv=Solve[{kreis[pm1,rk1]==0, kreis[pm2,rk2]==0},{x,y}];
      pSchnitt1={x,y}/.solv[[1]];
      pSchnitt2={x,y}/.solv[[2]];
      { pSchnitt1, pSchnitt2}
      ]; 
(*  25 *) 
gerade2Schnitt2[ pG1_,pG2_, qG1_,qG2_]:=
    Module[{gerade,λ,μ,pGI1,pGI2,λSchnitt,μSchnitt,
        pSchnitt1,pSchnitt2},
      Off[General::spell];
      gerade[λ_,pGI1_,pGI2_]:=pGI1+λ (pGI2-pGI1);
      solv=Flatten[Solve[{
              
              gerade[λ,pG1,pG2]== 
                gerade[μ,qG1,qG2]},{λ,μ}]];
      λSchnitt=λ/.solv[[1]];
      μSchnitt=μ/.solv[[2]];
      pSchnitt1=gerade[λSchnitt,pG1,pG2];
      pSchnitt2=gerade[μSchnitt,qG1,qG2];
      pSchnitt1
      ]; 
(*  26 *) 
geradeKreisSchnitt2[ pG1_,pG2_,pm_,r_]:=
    Module[{gerade,λ,μ,pGI1,pGI2,kreis,mVec,xVec,x,y,rkI},
      Off[General::spell];
      gerade[λ_,pGI1_,pGI2_]:=pGI1+λ (pGI2-pGI1);
      xVec[x_,y_]:={x,y};
      kreis[vec_,mVec_,rkI_]:=(vec-mVec).(vec-mVec)-rkI^2;
      solv=Flatten[Solve[
            
            kreis[{gerade[λ,pG1,pG2][[1]],
                  gerade[λ,pG1,pG2][[2]]},pm,r]==0,
            {λ}]];
      λSchnitt1=λ/.solv[[1]];
      λSchnitt2=λ/.solv[[2]];
      pSchnitt1=gerade[λSchnitt1,pG1,pG2];
      pSchnitt2=gerade[λSchnitt2,pG1,pG2];
      {pSchnitt1,pSchnitt2}
      ]; 
(*  27 *) 
mittelpunktStrecke2[ pG1_,pG2_]:=
    Module[
      {mP},
      Off[General::spell1];
      mP=(pG1+pG2)/2;
      mP
      ];
(*  28 *) 
mittelsenkrechte2[ pG1_,pG2_]:=
    Module[
      {hP1,hP2,punkt,qI1,qI2,φ},
      Off[General::spell];
      punkt[pI1_,
          pI2_,φ_]:=({{Cos[φ Degree],-Sin[φ \
Degree]},{Sin[φ Degree],Cos[φ Degree]}}.(pI2-pI1))+pI1;
      hP1=punkt[( pG1+pG2)/2,pG2,90];
      hP2=punkt[( pG1+pG2)/2,pG2,-90];
      { hP1,hP2}
      ];
(*  29 *) 
winkelhalbierende2[pO_ ,pG1_,pG2_]:=
    Module[
      {vLen,hW},
      Off[General::spell];
      vLen[v_]:=Sqrt[v.v];
      hW=pO+(pG1-pO) 1/vLen[(pG1-pO)]+(pG2-pO) 1/vLen[(pG2-pO)];
      If[Det[{pO-pG1,p0-pG2}]==0, hW={(-pO+pG1)[[2]],(pO-pG1)[[1]]}]; 
      { pO,hW}
      ];
(*  30 *) 
lotFussPunktGerade2[pG1_,pG2_,pQ_]:=
    Module[
      {g1,g2,λ,punkt,pI1,pI2,φ,pQ1,solv,pL1,pL2},
      Off[General::spell];
      g1[λ_]:=pG1+ λ (pG2-pG1);
      punkt[pI1_,
          pI2_,φ_]:=({{Cos[φ Degree],-Sin[φ \
Degree]},{Sin[φ Degree],Cos[φ Degree]}}.(pI2-pI1))+pI1;
      pQ1=punkt[pG1,pG2,90];
      g2[μ_]:=pQ+μ (pQ1-pG1);
      solv=Flatten[Solve[g1[λ]==g2[μ],{λ,μ}]];
      pL1=g1[λ]/.{solv[[1]]};
      pL2=g2[μ]/.{solv[[2]]};
      pL1
      ]; 
(*  31 *) 
spiegelungPunktAnGeraden[pG1_,pG2_,pQ_]:=
    Module[
      {g1,g2,λ,punkt,pI1,pI2,φ,pQ1,solv,pL1,pL2,
        spiegPu2Int},
      Off[General::spell];
      spiegPu2Int[p_,p0_]:=- p+2 p0 ;
      g1[λ_]:=pG1+ λ (pG2-pG1);
      punkt[pI1_,
          pI2_,φ_]:=({{Cos[φ Degree],-Sin[φ \
Degree]},{Sin[φ Degree],Cos[φ Degree]}}.(pI2-pI1))+pI1;
      pQ1=punkt[pG1,pG2,90];
      g2[μ_]:=pQ+μ (pQ1-pG1);
      solv=Flatten[Solve[g1[λ]==g2[μ],{λ,μ}]];
      pL1=g1[λ]/.{solv[[1]]};
      pL2=g2[μ]/.{solv[[2]]};
      spiegPu2Int[pQ,pL1]
      ];
(*  32 *) 
winkelFussPunktGerade2[pG1_,pG2_,pQ_,α_]:=
    Module[
      {g,λ,v,v1,v2,vLen,solv,pL,alpha},
      Off[General::spell];
      vLen[v_]:=Sqrt[v.v];
      g[λ_]:=pG1+ λ (pG2-pG1);
      v1[λ_]:=g[λ]-pQ;
      v2=pG2-pG1;
      alpha=2 Pi α  /360 ;
      solv=
        Flatten[Solve[
            Cos[alpha]^2==((v1[λ].v2)/(vLen[
                          v1[λ]]  vLen[v2]))^2,{λ}]];
      pL1=g[λ]/.solv[[1]];
      pL2=g[λ]/.solv[[2]];
      {pL1,pL2}
      ];
(*  33 *) 
pu2D[pu3D_]:={pu3D[[1]],pu3D[[3]]}+pu3D[[2]]/2{Sqrt[3]/2,1/2};
(*  34 *) 
kartKreuz3[p__]:=
    Show[Graphics[{Line[{{miNxN[p],0},{maXxN[p],0}}],
          Line[{{0,miNyN[p]},{0,maXyN[p]}}],
          li=Line[{-{Sqrt[3]/2,1/2}*miNxN[p],{Sqrt[3]/2,1/2}*maXxN[p]}]}],
      PlotRange->All,AspectRatio->Automatic,
      DisplayFunction->Identity];
kartKreuz3[{p__}]:=kartKreuz3[p];
kartKreuz3[p__]:=
    Show[Graphics[{Line[{{miNxN[p],0},{maXxN[p],0}}],
          Line[{{0,miNyN[p]},{0,maXyN[p]}}],
          Line[{- maXxN[p]*{Sqrt[3]/2,1/2}, maXxN[p]*{Sqrt[3]/2,1/2}}]}],
      AspectRatio->Automatic,DisplayFunction->Identity];
kartKreuz3[{p__}]:=kartKreuz3[p];
(*  35 *) 
<<Graphics`Arrow`;
arrAbs[p1_,p2_]:=
    Show[Graphics[{Arrow[p1,p2,HeadScaling->Absolute]}],
      PlotRange->All,AspectRatio->Automatic,
      DisplayFunction->Identity];
arrRel[p1_,p2_]:=
    Show[Graphics[{Arrow[p1,p2,HeadScaling->Relative]}],
      PlotRange->All,AspectRatio->Automatic,
      DisplayFunction->Identity];
(*  36 *) ;
Print["1. Putzmaschine"];
Print["2. Spell Off"];
Print["3. Vektorlänge"];
Print["4. Senkrechter ebener Vektor"];
Print["5. Liste machen"];
Print["6. Minimum und Maximum von Koordinaten einer Punktmenge"];
Print["7. Linienzug oder Serie von Linien zeichnen"];
Print["8. Linie der Dicke d zeichnen"];
Print["9. Linie mit Dashing zeichnen"];
Print["10. Linie mit Dicke d und Dashing zeichnen"];
Print["11. Kartesisches Achsenkreuz über einer Punktmenge zeichnen"];
Print["12. Dicke Punkte zeichnen"];
Print["13. Translation"];
Print["14. Spiegelung an einem Punkt"];
Print["15. Spiegelung an einer Ebene"];
Print["16. Spiegelung an einer Geraden"];
Print["17. Text an Punkt angelehnt"];
Print["18. Kreise zeichnen"];
Print["19. Bögen zeichnen"];
Print["20. Ellipse zeichnen"];
Print["21. Figurenkonstruktion zeichnen"];
Print["22. Drehung von Punkt um andern Punkt bei gegebenem Winkel in Grad"];
Print["23. Skizze Drehung von Punkt um andern Punkt bei gegebenem Winkel in Grad"];
Print["24. Schnitt von Kreisen"];
Print["25. Schnitt von Geraden"];
Print["26. Schnitt von Gerade mit Kreis"];
Print["27. Mittelpunkt einer Strecke"];
Print["28. Mittelsenkrechte zu zwei Punkten"];
Print["29. Winkelhalbierende zu drei Punkten"];
Print["30. Lotfusspunkt oder rechter Winkel an Gerade"];
Print["31. Spiegelung an Gerade"];
Print["32. Punkt auf Gerade von einem Punkt aus unter einem Winkel in Grad gesehen"];
Print["33. Eine Militärperspektive:2D aus 3D"];
Print["34. Kartesisches Achsenkreuz über einer Punktmenge in 3D zeichnen"];
Print["35. Pfeile"];
Print["36. Beispiele Pfeile u.s.w."];
Print["Dann noch einige Tests und Anwendungen"]
    ]

initGeo[1]