;  afkoord.lsp    Lisp-datei zum Zeichnen von Koordinaten an Ansichtsfenster
;  erstellt 12/03  Th.J.
;           06/07  einfaches Errorhandling hinzugefuegt
;           06/07  Fehler bei Abweichung von Koordinatenrichtung und Winkeleinheiten beseitigt
;           09/07  Auswahl ob Anschreiben innen oder aussen vom AF
;
;  Vorhaben: waehle Ansichtsfenter und zeichne im Plotbereich an das AF die Koordinaten (Linien und Werte)
;            des dargestellten (Lage)planausschnittes
;
;
(princ "Start mit afkoord")

; Errorhandling
(defun my_error (msg)
  (print (strcat "Fehler aufgetreten: " msg))
  (command "_undo" "_back")
  (setq *error* alterror)
  (setvar "blipmode" sblip)
  (setvar "cmdecho" scmde)
  (setvar "osmode" sosmode)
  (setvar "angbase" sangbase)
  (setvar "angdir" sangdir)
  (setvar "aunits" saunits) 

  (princ)
)

;(DEFUN C:ele ()                    ; gefunden in lisp-forum von cad.de
;
(defun #VPT_BOX ( $view /                        ; Ename of viewport
                  v_eed                          ; Viewport entity list including EED
                  v_psw                          ; Paper space width
                  v_psh                          ;            height
                  v_msw                          ; Model space width
                  v_msh                          ;            height
                  v_msxp                        ;            view centre x point
                  v_msyp                        ;                        y point
                  v_ang                          ;            twist angle
                  v_xy1                          ;            left bottom point
                  v_xy2                          ;            right bottom point
                  v_xy3                          ;            right top point
                  v_xy4                          ;            left top point
                  v_scale                        ;            scale
                  #ent_gc                        ; Local function
                )
  (defun #ENT_GC ( $gc $list )                  ; Return group code from list
    (cdr (assoc $gc $list))                      ; |
  );end defun #ENT_GC                            ; |

  (defun #TRG_ROT ( $point    ; 2D point        ; Rotate point
                    $angle   ; Angle in radians ; |
                    $offsetx ; x of offset
		    $offsety / ; y of offset
		    x y      ; x & y of $point  ; |
                    ca sa    ; cos/sin of $angle; |
                  )                              ; |
    (setq x  (car  $point)                      ; |
          y  (cadr $point)                      ; |
          ca (cos  $angle)                      ; |
          sa (sin  $angle)                      ; |
    )                                            ; |
    (list (+ (- (* x ca) (* y sa)) $offsetx)     ; |
          (+ (* x sa) (* y ca) $offsety)         ; |
    )                                            ; |
  );end defun #TRG_ROT                          ; |

                                                ; **** MAIN BODY ****
  (if (and (= 'ENAME (type $view))              ; if Ename passed and...
          (setq v_eed (entget $view '("ACAD"))) ; .. got entity list and...
          (= "VIEWPORT" (#ent_gc 0 v_eed))      ; .. is viewport
      )                                          ; |
    (progn                                      ; |
      (setq v_psw  (#ent_gc 40 v_eed)          ; |  paper space width
            v_psh  (#ent_gc 41 v_eed)          ; |  paper space height
            v_eed  (cdar (#ent_gc -3 v_eed))    ; |  extended entity data
                                            ;  take ms dest. point into account (GC 17, EED 1010) (offset of coord-systems)
	    v_eed_dp (member (assoc 1010 v_eed) v_eed)
	    v_dpxy (#ent_gc 1010 v_eed_dp)
	    v_dpx (car v_dpxy)
	    v_dpy (cadr v_dpxy)
	                                    ; end of dest.point data
	    v_eed  (member                      ; |  discard EED before twist angle
                      (assoc 1040 v_eed) v_eed  ; |  |
                    )                            ; |  |
            v_ang  (#ent_gc 1040 v_eed)        ; |  1st gc 1040 (twist angle)
            v_eed  (cdr v_eed)                  ; |  remainder of eed
            v_msh  (#ent_gc 1040 v_eed)        ; |  2nd gc 1040 (view height)
            v_eed  (cdr v_eed)                  ; |  remainder of eed
            v_msxp  (#ent_gc 1040 v_eed)        ; |  3rd gc 1040 (view x point)
            v_eed  (cdr v_eed)                  ; |  remainder of eed
            v_msyp  (#ent_gc 1040 v_eed)        ; |  4th gc 1040 (view y point)
            v_scale (/ v_psh v_msh)              ; |  scale
            v_msw  (/ v_psw  v_scale)          ; |  ms width
            v_xy1  (list (- v_msxp (/ v_msw 2.0)) ; |  ms left border and ...
                         (- v_msyp (/ v_msh 2.0)) ; |    bottom border
                    )                            ; |
      )                                          ; | 

      (setq v_ang (- (* 2.0 pi) v_ang)            ; |
            v_xy1 (#trg_rot v_xy1 v_ang v_dpx v_dpy)  ; |  1st point
            v_xy2 (polar v_xy1 v_ang v_msw)      ; |  2nd point
            v_ang (+ v_ang (/ pi 2.0))            ; |  turn 90 deg
            v_xy3 (polar v_xy2 v_ang v_msh)      ; |  3rd point
            v_ang (+ v_ang (/ pi 2.0))            ; |  turn 90 deg
            v_xy4 (polar v_xy3 v_ang v_msw)      ; |  4th point
      )                                          ; |
      (PRINC v_msxp)                                  
      (TERPRI)
      (PRINC v_msyp)
      (TERPRI)  
      (list v_xy1 v_xy2 v_xy3 v_xy4)            ; |  corner points
    );end progn                                  ; |  
  );end if                                      ; end if
);end defun #VPT_BOX
 ;
(defun antwort(frage antw1 antw2 / antw kw)
  (setq kw (strcat antw1 " " antw2))
  (initget 1 kw)
  (setq antw (substr (getkword frage) 1 1))
) ; ende defun antwort

 ; jetzt gehts los
 ;
(defun C:afkoord( / alterror sblip scmd sosmode al anz x axl zen_af zen_af_x zen_af_y zen_modw zen_mod_xw zen_mod_yw
		    br_af h_af h_mod affakt br_mod alpha liun_af_x liob_af_x reun_af_x reob_af_x liun_af_y liob_af_y
		    reun_af_y reob_af_y element punkte liun_mb liob_mb reun_mb reob_mb liun_mb_x liob_mb_x reun_mb_x
		    reob_mb_x liun_mb_y liob_mb_y reun_mb_y reob_mb_y startx starty delta_l delta_m delta_a cy_af
		    richtg textht textri textausri cx_mb minx maxx delta_m1 cx_af ctext p1 p2 pt cy_mb miny maxy 
                )
  (setq alterror *error*)
  (setq *error* my_error)
  (command "_undo" "_mark")

 (print "Ansichtsfensterkoordinaten")
 ;
 ; ein paar vorbereitungen
 ;
 (setq sblip (getvar "blipmode"))
 (setq scmde (getvar "cmdecho"))
 (setq sosmode (getvar "osmode"))
 (setq sangbase (getvar "angbase"))
 (setq sangdir (getvar "angdir"))
 (setq saunits (getvar "aunits")) 
 (setvar "blipmode" 0)
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 (setvar "angbase" 0)
 (setvar "angdir" 0)
 (setvar "aunits" 0) 

 ;  waehle Fenster
 (setq anz 0 al (ssget '((0 . "VIEWPORT"))))
 ;(setq anz (sslength al))
 (if al (setq anz (sslength al)) (print "kein Ansichtsfenster gewaehlt"))
 (setq x 0)
 (while (< x anz)
   (setq axl (entget (ssname al x)))
   ;
   ; pruefen ob ansichtsfenster
   ;
   (if (= "VIEWPORT" (cdr (assoc 0 axl)))
       (progn
          (setq zen_af (cdr (assoc 10 axl)))
          (setq zen_af_x (car zen_af))
          (setq zen_af_y (cadr zen_af))
          (setq zen_modw (cdr (assoc 12 axl)))
          (setq zen_mod_xw (car zen_modw))
          (setq zen_mod_yw (cadr zen_modw))
          (setq br_af (cdr (assoc 40 axl)))
          (setq h_af (cdr (assoc 41 axl)))
          (setq h_mod (cdr (assoc 45 axl)))
          (setq affakt (/ h_af h_mod))
          (setq br_mod (/ br_af affakt))
          (setq alpha (cdr (assoc 51 axl)))
          ;
          ;
          ; eckpunkte ansichtsfenster (annahme nicht gedreht)
          ;
          (setq liun_af_x (- zen_af_x (/ br_af 2.)))
          (setq liob_af_x (- zen_af_x (/ br_af 2.)))
          (setq reun_af_x (+ zen_af_x (/ br_af 2.)))
          (setq reob_af_x (+ zen_af_x (/ br_af 2.)))
          (setq liun_af_y (- zen_af_y (/ h_af 2.)))
          (setq liob_af_y (+ zen_af_y (/ h_af 2.)))
          (setq reun_af_y (- zen_af_y (/ h_af 2.)))
          (setq reob_af_y (+ zen_af_y (/ h_af 2.)))
          ;
          ;  OK bis hier, nun koordinaten der Eckpunkte fuer Modellbereich ermitteln
          ;
          ; dafür haben wir im lisp forum etwas gefunden
          ;
          (setq element (cdr (assoc -1 axl)))
          (SETQ punkte (#VPT_BOX element))
          ;
          ; punkte extrahieren
          ;
          (setq liun_mb (nth 0 punkte))
          (setq reun_mb (nth 1 punkte))
          (setq reob_mb (nth 2 punkte))
          (setq liob_mb (nth 3 punkte))
          (setq liun_mb_x (car liun_mb))
          (setq liun_mb_y (cadr liun_mb))
          (setq liob_mb_x (car liob_mb))
          (setq liob_mb_y (cadr liob_mb))
          (setq reun_mb_x (car reun_mb))
          (setq reun_mb_y (cadr reun_mb))
          (setq reob_mb_x (car reob_mb))
          (setq reob_mb_y (cadr reob_mb))
          ;
          ; Ausgabe Extremwerte und Abfrage Startwerte und Schrittweiten
          ;
          (print "Mininmal- und Maximalwert x ")
          (princ (min liun_mb_x liob_mb_x reun_mb_x reob_mb_x))
          (princ "  ")
          (princ "  ")
          (princ (max liun_mb_x liob_mb_x reun_mb_x reob_mb_x))
          (print "Mininmal- und Maximalwert y")
          (princ (min liun_mb_y liob_mb_y reun_mb_y reob_mb_y))
          (princ "  ")
          (princ "  ")
          (princ (max liun_mb_y liob_mb_y reun_mb_y reob_mb_y))
          (terpri)
          (initget 1)
          (setq startx (getreal  "Startwert fuer x-Koordinaten angeben "))
          (setq starty (getreal "Startwert fuer y-Koordinaten angeben "))
          (initget 3)
          (setq delta_l (getreal "Schrittweite fuer Koordinaten angeben "))

      	  (setq lraussen (= (antwort "\nKoordinatenanschrieb Innen/Aussen des AF [I/A] :" "Innen" "Aussen") "A"))
          ;
          ; Werte pruefen und setzen (lassen wir noch offen)
          ;
          ;
          ; jetzt gehts richtig los
          ;
          ; unterer Rand, x werte
          ;
          (setq delta_m (- reun_mb_x liun_mb_x))  ; dargestellte Koord.diff im Modellb.
          (setq delta_a (- reun_af_x liun_af_x))  ; dargestellte Koord.diff im Ansichtsf.
          (setq cy_af liun_af_y)
          (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.))))  ; Richtg. der Linie in Abh. von Drehung MB in AF
            (setq richtg (- alpha (/ pi 2.)))
            (setq richtg (+ alpha (/ pi 2.)))
          ) ; end if 
          (if (< richtg 0) (setq richtg (+ richtg pi pi)))   ; nur Richtung 0 .. 2pi zulaessig
          (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi)))
          (setq textht 2)
          (if (< richtg (/ pi 2))                 ; Textrichtg. in Abh. von Linienrichtg.
            (progn (setq textri (/ (* richtg 180 ) pi))
                   (setq textausri (if lraussen "mr" "ml"))
            ) ; end progn
            (progn (setq textri (/ (* (- richtg pi) 180 ) pi))
                   (setq textausri (if lraussen "ml" "mr"))
            ) ; end progn
          ) ; end if
	  (if lraussen (setq richtg (+ richtg pi)))
          (setq cx_mb startx)
          (setq minx (min liun_mb_x reun_mb_x))  ; es kann auch in negativer Richtung verlaufen
          (setq maxx (max liun_mb_x reun_mb_x))
          (while (<= cx_mb minx)                 ; ersten auf Rand im MB vorh. Wert ermitteln
            (setq cx_mb (+ cx_mb delta_l))
          ) ; end while cx_mb
          (while (< cx_mb maxx)
            (setq delta_m1 (- cx_mb liun_mb_x))  ; Streckenverhaeltnisse
            (setq cx_af (+ liun_af_x (* (/ delta_m1 delta_m) delta_a)))
            (setq ctext (rtos cx_mb 2 0))
            (setq p1 (list cx_af cy_af))
            (setq p2 (polar p1 richtg 5))
            (setq pt (polar p1 richtg 6))

            (command "linie" p1 p2 "")
            (command "text" "p" textausri pt textht textri ctext)

            (setq cx_mb (+ cx_mb delta_l))
          ) ; end while cx_mb


          ; oberer Rand, x werte
          ;
          (setq delta_m (- reob_mb_x liob_mb_x))
          (setq delta_a (- reob_af_x liob_af_x))
          (setq cy_af liob_af_y)
          (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.))))
            (setq richtg (+ alpha (/ pi 2.)))
            (setq richtg (- alpha (/ pi 2.)))
          ) ; end if 
          (if (< richtg 0) (setq richtg (+ richtg pi pi)))
          (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi)))
          (setq textht 2)
          (if (< richtg (* pi 1.5))
            (progn (setq textri (/ (* (- richtg pi) 180 ) pi))
                   (setq textausri (if lraussen "ml" "mr"))
            ) ; end progn
            (progn (setq textri (/ (* richtg 180 ) pi))
                   (setq textausri (if lraussen "mr" "ml"))
            ) ; end progn
          ) ; end if
	  (if lraussen (setq richtg (+ richtg pi)))
          (setq cx_mb startx)
          (setq minx (min liob_mb_x reob_mb_x))
          (setq maxx (max liob_mb_x reob_mb_x))
          (while (<= cx_mb minx)
            (setq cx_mb (+ cx_mb delta_l))
          ) ; end while cx_mb
          (while (< cx_mb maxx)
            (setq delta_m1 (- cx_mb liob_mb_x))
            (setq cx_af (+ liob_af_x (* (/ delta_m1 delta_m) delta_a)))
            (setq ctext (rtos cx_mb 2 0))
            (setq p1 (list cx_af cy_af))
            (setq p2 (polar p1 richtg 5))
            (setq pt (polar p1 richtg 6))

            (command "linie" p1 p2 "")
            (command "text" "p" textausri pt textht textri ctext)

            (setq cx_mb (+ cx_mb delta_l))
          ) ; end while cx_mb

          ; linker Rand, x werte
          ;
          (setq delta_m (- liob_mb_x liun_mb_x))
          (setq delta_a (- liob_af_y liun_af_y))
          (setq cx_af liun_af_x)
          (if (> alpha pi)
            (setq richtg (+ alpha (/ pi 2.)))
            (setq richtg (- alpha (/ pi 2.)))
          ) ; end if 
          (if (< richtg 0) (setq richtg (+ richtg pi pi)))
          (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi)))
          (setq textht 2)
          (setq textri (/ (* richtg 180 ) pi))
;	  (setq textausri "ml")
          (setq textausri (if lraussen "mr" "ml"))
	  (if lraussen (setq richtg (+ richtg pi)))
          
          (setq cx_mb startx)
          (setq minx (min liob_mb_x liun_mb_x))
          (setq maxx (max liob_mb_x liun_mb_x))
          (while (<= cx_mb minx)
            (setq cx_mb (+ cx_mb delta_l))
          ) ; end while cx_mb
          (while (< cx_mb maxx)
            (setq delta_m1 (- cx_mb liun_mb_x))
            (setq cy_af (+ liun_af_y (* (/ delta_m1 delta_m) delta_a)))
            (setq ctext (rtos cx_mb 2 0))
            (setq p1 (list cx_af cy_af))
            (setq p2 (polar p1 richtg 5))
            (setq pt (polar p1 richtg 6))

            (command "linie" p1 p2 "")
            (command "text" "p" textausri pt textht textri ctext)

            (setq cx_mb (+ cx_mb delta_l))
          ) ; end while cx_mb

          ; rechter Rand, x werte
          ;
          (setq delta_m (- reob_mb_x reun_mb_x))
          (setq delta_a (- reob_af_y reun_af_y))
          (setq cx_af reun_af_x)
          (if (< alpha pi)
            (setq richtg (+ alpha (/ pi 2.)))
            (setq richtg (- alpha (/ pi 2.)))
          ) ; end if 
          (if (< richtg 0) (setq richtg (+ richtg pi pi)))
          (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi)))
          (setq textht 2)
          (setq textri (/ (* (- richtg pi) 180 ) pi))
          (setq textausri (if lraussen "ml" "mr"))
	  (if lraussen (setq richtg (+ richtg pi)))
          
          (setq cx_mb startx)
          (setq minx (min reob_mb_x reun_mb_x))
          (setq maxx (max reob_mb_x reun_mb_x))
          (while (<= cx_mb minx)
            (setq cx_mb (+ cx_mb delta_l))
          ) ; end while cx_mb
          (while (< cx_mb maxx)
            (setq delta_m1 (- cx_mb reun_mb_x))
            (setq cy_af (+ reun_af_y (* (/ delta_m1 delta_m) delta_a)))
            (setq ctext (rtos cx_mb 2 0))
            (setq p1 (list cx_af cy_af))
            (setq p2 (polar p1 richtg 5))
            (setq pt (polar p1 richtg 6))

            (command "linie" p1 p2 "")
            (command "text" "p" textausri pt textht textri ctext)

            (setq cx_mb (+ cx_mb delta_l))
          ) ; end while cx_mb


          ; linker Rand, y werte
          ;
          (setq delta_m (- liob_mb_y liun_mb_y))
          (setq delta_a (- liob_af_y liun_af_y))
          (setq cx_af liun_af_x)
          (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.))))
            (setq richtg (+ pi alpha))
            (setq richtg (+ alpha))
          ) ; end if 
          (if (< richtg 0) (setq richtg (+ richtg pi pi)))
          (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi)))
          (setq textht 2)
          (setq textausri (if lraussen "mr" "ml"))
          (setq textri (/ (* richtg 180 ) pi))
	  (if lraussen (setq richtg (+ richtg pi)))
	 
          (setq cy_mb starty)
          (setq miny (min liob_mb_y liun_mb_y))
          (setq maxy (max liob_mb_y liun_mb_y))
	 
          (while (<= cy_mb miny)
            (setq cy_mb (+ cy_mb delta_l))
          ) ; end while cy_mb
          (while (< cy_mb maxy)
            (setq delta_m1 (- cy_mb liun_mb_y))
            (setq cy_af (+ liun_af_y (* (/ delta_m1 delta_m) delta_a)))
            (setq ctext (rtos cy_mb 2 0))
            (setq p1 (list cx_af cy_af))
            (setq p2 (polar p1 richtg 5))
            (setq pt (polar p1 richtg 6))

            (command "linie" p1 p2 "")
            (command "text" "p" textausri pt textht textri ctext)

            (setq cy_mb (+ cy_mb delta_l))
          ) ; end while cy_mb


          ; rechter Rand, y werte
          ;
          (setq delta_m (- reob_mb_y reun_mb_y))
          (setq delta_a (- reob_af_y reun_af_y))
          (setq cx_af reun_af_x)
          (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.))))
            (setq richtg (+ alpha))
            (setq richtg (+ pi alpha))
          ) ; end if 
          (if (< richtg 0) (setq richtg (+ richtg pi pi)))
          (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi)))
          (setq textht 2)
          (setq textri (/ (* (- richtg pi) 180 ) pi))
          (setq textausri (if lraussen "ml" "mr"))
	  (if lraussen (setq richtg (+ richtg pi)))
	
          (setq cy_mb starty)
          (setq miny (min reun_mb_y reob_mb_y))
          (setq maxy (max reun_mb_y reob_mb_y))
          (while (<= cy_mb miny)
            (setq cy_mb (+ cy_mb delta_l))
          ) ; end while cy_mb
          (while (< cy_mb maxy)
            (setq delta_m1 (- cy_mb reun_mb_y))
            (setq cy_af (+ reun_af_y (* (/ delta_m1 delta_m) delta_a)))
            (setq ctext (rtos cy_mb 2 0))
            (setq p1 (list cx_af cy_af))
            (setq p2 (polar p1 richtg 5))
            (setq pt (polar p1 richtg 6))

            (command "linie" p1 p2 "")
            (command "text" "p" textausri pt textht textri ctext)

            (setq cy_mb (+ cy_mb delta_l))
          ) ; end while cy_mb

          ; unterer Rand, y werte
          ;
          (setq delta_m (- reun_mb_y liun_mb_y))
          (setq delta_a (- reun_af_x liun_af_x))
          (setq cy_af liun_af_y)
          (if (< alpha pi)
            (setq richtg (+ alpha))
            (setq richtg (+ pi alpha))
          ) ; end if 
          (if (< richtg 0) (setq richtg (+ richtg pi pi)))
          (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi)))
          (setq textht 2)
          (if (< richtg (/ pi 2))
            (progn (setq textri (/ (* richtg 180 ) pi))
                   (setq textausri (if lraussen "mr" "ml"))
            ) ; end progn
            (progn (setq textri (/ (* (- richtg pi) 180 ) pi))
                   (setq textausri (if lraussen "ml" "mr"))
            ) ; end progn
          ) ; end if
	  (if lraussen (setq richtg (+ richtg pi)))
          
          (setq cy_mb starty)
          (setq miny (min liun_mb_y reun_mb_y))
          (setq maxy (max liun_mb_y reun_mb_y))
          (while (<= cy_mb miny)
            (setq cy_mb (+ cy_mb delta_l))
          ) ; end while cy_mb
          (while (< cy_mb maxy)
            (setq delta_m1 (- cy_mb liun_mb_y))
            (setq cx_af (+ liun_af_x (* (/ delta_m1 delta_m) delta_a)))
            (setq ctext (rtos cy_mb 2 0))
            (setq p1 (list cx_af cy_af))
            (setq p2 (polar p1 richtg 5))
            (setq pt (polar p1 richtg 6))

            (command "linie" p1 p2 "")
            (command "text" "p" textausri pt textht textri ctext)

            (setq cy_mb (+ cy_mb delta_l))
          ) ; end while cy_mb

          ; oberer Rand, y werte
          ;
          (setq delta_m (- reob_mb_y liob_mb_y))
          (setq delta_a (- reob_af_x liob_af_x))
          (setq cy_af liob_af_y)
          (if (< alpha pi)
            (setq richtg (+ pi alpha))
            (setq richtg (+ alpha))
          ) ; end if 
          (if (< richtg 0) (setq richtg (+ richtg pi pi)))
          (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi)))
          (setq textht 2)
          (if (< richtg (* pi 1.5))
            (progn (setq textri (/ (* (- richtg pi) 180 ) pi))
                   (setq textausri (if lraussen "ml" "mr"))
            ) ; end progn
            (progn (setq textri (/ (* richtg 180 ) pi))
                   (setq textausri (if lraussen "mr" "ml"))
            ) ; end progn
          ) ; end if
	  (if lraussen (setq richtg (+ richtg pi)))
          
          (setq cy_mb starty)
          (setq miny (min liob_mb_y reob_mb_y))
          (setq maxy (max liob_mb_y reob_mb_y))
          (while (<= cy_mb miny)
            (setq cy_mb (+ cy_mb delta_l))
          ) ; end while cy_mb
          (while (< cy_mb maxy)
            (setq delta_m1 (- cy_mb liob_mb_y))
            (setq cx_af (+ liob_af_x (* (/ delta_m1 delta_m) delta_a)))
            (setq ctext (rtos cy_mb 2 0))
            (setq p1 (list cx_af cy_af))
            (setq p2 (polar p1 richtg 5))
            (setq pt (polar p1 richtg 6))

            (command "linie" p1 p2 "")
            (command "text" "p" textausri pt textht textri ctext)

            (setq cy_mb (+ cy_mb delta_l))
          ) ; end while cy_mb

	 ) ;end progn
   ) ; end if viewport
   (setq x (1+ x))
 )
 ;
 ; Ausgangsbedingungen wieder herstellen
 ;
 (setvar "blipmode" sblip)
 (setvar "cmdecho" scmde)
 (setvar "osmode" sosmode)
 (setvar "angbase" sangbase)
 (setvar "angdir" sangdir)
 (setvar "aunits" saunits) 
 (setq *error* alterror)
 (prompt "Koordinaten gesetzt")
 (princ)

)