;
;           NC - Programm  1.0    04.04.1995   MP
;          ----------------------


(defun *error* (st)
   (princ "  Fehler: ")
   (princ st)
   (terpi)
)

;------------------------------------------------
;    Programm zum Objektfang

(defun OWahl (/ e neu alt)
  (setq e nil)
  (while (null e)
    (setq e (entsel "\nObjekt waehlen : "))
    (if e
       (progn   (setq e (car e))
                (setq en (entget e))
                (setq ename (cdr (assoc 0 en)))

                (if (= ename "ARC")
                    (progn   (setq cen (cdr (assoc 10 en)))
                             (setq rad (cdr (assoc 40 en)))
                             (setq start_w (cdr (assoc 50 en)))
                             (setq end_w (cdr (assoc 51 en)))
                    ) ;end * progn
                    (progn   (setq cen nil)
                             (setq rad nil)
                    ) ;end * progn
                ) ;end * if "ARC"
                (if (= ename "LINE")
                    (progn   (setq start_p (cdr (assoc 10 en)))
                             (setq end_p (cdr (assoc 11 en)))
                    ) ;end * progn
                ) ;end * if "LINE"


                ;  test

                (prompt "\n - Ein(e) ")
                (princ ename)

                ;(setq alt (assoc 8 en))
                ;(setq neu '(8 . "cnc"))
                ;(setq en(subst neu alt en))
                ;(entmod en)

                (command "_erase" e "")

       ) ;end * progn
    ) ;end * if e *
  ) ;end * while (null e) *

  (setq alt nil)
  (setq neu nil)
  (setq e nil)
  (setq en nil)
) ;end * defun owahl *

; -----------------------------------------------

(defun runden (z)
  (setq str_z (rtos z 2 3))
) ;end * defun runden

; -----------------------------------------------

(defun P_runden (z)
  (setq str_p (strcat (runden (car z)) "\t" (runden (cadr z))))
) ;end * defun P_runden

; -----------------------------------------------

(defun fixen (zahl)
  (setq zahl (* zahl 1000))
  (setq zahl (+ zahl 0.5))
  (setq zahl (fix zahl))
  (setq zahl (/ zahl 1000.0))
)

;------------------------------------------------
;

(defun C:NC (/ p1 p2 p3)
  (setvar "Cmdecho" 0)
  (prompt "\nDateiname  <")
  (princ Dateiname)
  (prompt "> : ")
  ;
  (if (= Dateiname nil) (setq Dateiname (getstring)))
  (setq status (Open Dateiname "a"))
  (Prompt "\t.Datei geoeffnet\n")
  ;
  (if (= anf_p nil)
      (progn
        (setq anf_p (getpoint "\nAnfangspunkt : "))
        (setq anf_p (mapcar '(lambda (x) (fixen x)) anf_p))
        (setq satz "G00 G90 G40 G80 X")
        (setq satz (strcat satz (runden (car anf_p))
                                " Y" (runden (cadr anf_p))
                                " ( Erstellt mit PROG-NC 1.0 )" "\n"))
  
  (setq text1 (getstring T "\nProgramm Nr. : "))   
  (setq text2 (getstring T "\nText : "))
  
  (princ text1 status)
  (princ "\n"status)
  (princ text2 status)
  (princ "\n" status)
        
        (princ satz status)
        (princ "\n" status)
      
  ;(setvar "cmdecho" 0)
  (setq text3 (getstring T "\nZustellung in Z: "))   
  (setq text4 (getstring T "\nG41/G42 1 oder 2: "))
  
  (princ "G00 Z-" status)
  (princ text3 status)
  (princ "\n"status)
  (princ "G4" status)
  (princ text4 status)
  (princ "\n" status)
      )
  )
  ;
  (OWahl)
  ;
  (setq nr 10)
  (setq nr1 (+ nr nr1))
  
  
  (if (= ename "LINE")
  (progn
    (setq start_p (mapcar '(lambda (x) (fixen x)) start_p))
    (setq end_p (mapcar '(lambda (x) (fixen x)) end_p))

    (setq satz " G01")
    (if (equal anf_p start_p)
        (progn (setq satz (strcat satz " X" (runden (car end_p))
                                       " Y" (runden (cadr end_p)) "\n"))
               (setq anf_p end_p)
        )
        (progn (setq satz (strcat satz " X" (runden (car start_p))
                                       " Y" (runden (cadr start_p)) "\n"))
               (setq anf_p start_p)
        )
    )
    (princ "\n") (princ satz)
    (princ "N" status)
    (princ nr1 status)
    (princ satz status)
  ))


  (if (= ename "ARC")
  (progn
    (setq start_p (polar cen start_w rad))
    (setq end_p (polar cen end_w rad))

    (setq start_p (mapcar '(lambda (x) (fixen x)) start_p))
    (setq end_p (mapcar '(lambda (x) (fixen x)) end_p))
    (setq cen (mapcar '(lambda (x) (fixen x)) cen))

    (if (equal anf_p start_p)
        (progn (setq satz " G03")
               (setq cen (mapcar '- cen anf_p))
               (setq satz (strcat satz " X" (runden (car end_p))
                                       " Y" (runden (cadr end_p))
                                       " R" (runden rad) "\n"))
               (setq anf_p end_p)
        )
        (progn (setq satz " G02")
               (setq cen (mapcar '- cen anf_p))
               (setq satz (strcat satz " X" (runden (car start_p))
                                       " Y" (runden (cadr start_p))
                                       " R" (runden rad) "\n"))
               (setq anf_p start_p)
        )
    )
    (princ "\n") (princ satz)
    (princ "N" status)
    (princ nr1 status)
    (princ satz status)
  ))

  (if (and (/= ename "LINE") (/= ename "ARC"))
    (princ "\n * kein gueltiges Element *")
  )

  ;
  (close status)
  (command "ofang" "keiner")
  ;
  (princ)
)
; -------    E N D E    -------------------------