(defun c:acadin ( / echo fakt file firstrun krddat masstab osm pktanz zeilanz)
  (prompt "Copyright (c) 2000 by E. DIETRICH, A-2122 Ulrichskirchen")
  (command "_.UNDO" "_END")
  (command "_.UNDO" "_GROUP")
  (setq acadin-olderr *error*
        *error* ederr
        echo (getvar "CMDECHO")
        osm (getvar "OSMODE")
        fdia (getvar "FILEDIA")
  )
  (setvar "OSMODE" 0)
  (setvar "CMDECHO" 0)
  (setvar "FILEDIA" 1)

  (if (not acadin-masstab)
    (setq acadin-masstab (float (getint "\nBitte Masstab der Zeichnung eingeben 1: ")))
    (if (setq acadin-masstabv (getint (strcat "\nBitte Masstab der Zeichnung eingeben 1:<" (rtos                acadin-masstab 2 0) "> ")))
      (setq acadin-masstab (float acadin-masstabv))
    )
  )
  (setq fakt (/ acadin-masstab 1000))        ;weil die Symbole für M=1:1000 (Symbolgrößen in mm, Maßeinheit= m) definiert sind
  (acadincfg)

;;; Die nachfolgende Zeile wurde auskommentiert, kann aber anstelle der
;;; übernächsten Zeile verwendet werden - ev. Pfad anpassen
;;;  (if (setq file (getfiled "Ascii-Koordinaten-Datei auswählen" "c:/acadin/" "" 4))
  (if (setq file (getfiled "Ascii-Koordinaten-Datei auswählen" "" "" 4))
    (setq krddat (open file "r"))
    (ederr "\nKeine ASCII-Koordinaten-Datei ausgewählt !")
  )
  (if (not (setq acadin-kommast (getint (strcat "\nHöhen auf wieviele Kommastellen: <" (itoa (getvar "LUPREC")) "> "))))
    (setq acadin-kommast (getvar "LUPREC"))
  )
  (setq acadin-testmc T)
  (setq acadin-pktanz 0)
  (setq zeilanz 0)
  (princ "\nPunkte werden eingelesen - bitte warten ...\n")
  (while (setq acadin-zlk (read-line krddat))
    (setq zeilanz (1+ zeilanz))
    (readkrd)
    (if (and (< 0 acadin-mc) (<= acadin-mc 9))        ;Messcode-Grenzen, Punkte mit Code 0 werden übergangen
      (readmc acadin-mc)
      (setq acadin-blk nil)
    )
    (if acadin-blk
      (progn
        (if (= acadin-pktanz 0)                ;Zoomen zum ersten Punkt - damit man am Schirm was sieht
          (command "_.ZOOM" "_C" acadin-koord 222)
        )
   (cond 
     ((= acadin-attranz 0)
       (command "_insert" acadin-blk acadin-koord fakt "" "")
     )
     ((= acadin-attranz 1)
       (command "_insert" acadin-blk acadin-koord fakt "" "" acadin-pktnr)
     )
     ((= acadin-attranz 2)
       (command "_insert" acadin-blk acadin-koord fakt "" "" acadin-pktnr acadin-höhe)
     )
     ((= acadin-attranz 3)
       (command "_insert" acadin-blk acadin-koord fakt "" "" acadin-pktnr acadin-höhe acadin-attr3)
     )
     ((= acadin-attranz 4)
       (command "_insert" acadin-blk acadin-koord fakt "" "" acadin-pktnr acadin-höhe acadin-attr3 acadin-attr4)
     )
     ((= acadin-attranz 5)
       (command "_insert" acadin-blk acadin-koord fakt "" "" acadin-pktnr acadin-höhe acadin-attr3 acadin-attr4 acadin-attr5)
     )
   )     
        (cheig)
;;; Hier könnte man das Programm um das Einfügen von Zusatzblöcken erweitern
        (setq acadin-pktanz (1+ acadin-pktanz))
      )
      (progn
        (if acadin-testmc
          (setq acadin-testmc T)
        )
      )
    )
  )
  (print)
  (close krddat)
  (setvar "CMDECHO" echo)
  (setvar "OSMODE" osm)
  (setvar "FILEDIA" fdia)
  (command "_.ZOOM" "_Extents")
  (command "_.UNDO" "_END")
  (princ (strcat "\n" (itoa acadin-pktanz) " Punkte eingelesen, " ))
  (princ (strcat "\n" (itoa zeilanz) " stehen im File!"))
  (princ)
)
;;;------------------------------------------------------------------------
(defun readkrd ( / x y)
  (setq acadin-pktnr (no1bl (substr acadin-zlk acadin-pktanf acadin-pktlg)))
  (setq y (atof (nobl (substr acadin-zlk acadin-yanf acadin-ylg))))
  (setq x (atof (nobl (substr acadin-zlk acadin-xanf acadin-xlg))))
;;;  (setq acadin-koord (list y x))
  (setq acadin-höhe (nobl (substr acadin-zlk acadin-hanf acadin-hlg)))

;;;  (if (/= acadin-höhe "")
;;;    (setq acadin-höhe (rtos (atof acadin-höhe) 2 acadin-kommast))
;;;  )

  (if (/= acadin-höhe "")                                                  ;-
    (progn                                                                 ; |
      (setq acadin-koord (list y x (atof acadin-höhe)))                    ; |
      (setq acadin-höhe (rtos (atof acadin-höhe) 2 acadin-kommast))        ; |  Bearbeitet, damit Blöcke mit Höhe eingelesen werden. Stefan Wickel
    )                                                                      ; |
    (setq acadin-koord (list y x))                                         ; |
  )                                                                        ;-
  
  (setq tmpmc (nobl (substr acadin-zlk acadin-mcanf acadin-mclg)))
  (if (= tmpmc ".")
    (setq tmpmc "1")
  )
  (setq acadin-mc (atoi tmpmc))
  (setq acadin-attr3 (nobl (substr acadin-zlk acadin-attr3anf acadin-attr3lg)))
  (setq acadin-attr4 (nobl (substr acadin-zlk acadin-attr4anf acadin-attr4lg)))
  (setq acadin-attr5 (nobl (substr acadin-zlk acadin-attr5anf acadin-attr5lg)))
)
;;;------------------------------------------------------------------------
(defun readmc (acadin-mc / datmc)
  (setq datmc (open acadin-mcdef "r"))   ;Messcode-def-Datei zum lesen öffnen
  (if (/= acadin-mc 0)
    (repeat acadin-mc
      (setq acadin-zl (read-line datmc))
    )
    (progn
      (setq acadin-blk nil)
      (setq acadin-testmc nil)
    )
  )
  (close datmc)                        ;Messcode-def-Datei schließen
  (setq acadin-mc (read acadin-zl))
  (setq acadin-zl (substr acadin-zl 4))
  (if (not (= acadin-zl ""))
    (progn
      (setq acadin-blk (rdef))
      (setq acadin-attranz (rdef))
      (setq acadin-attranz (atoi acadin-attranz))
      (makelay (setq acadin-blay (rdef)))
      (makelay (setq acadin-pnlay (rdef)))
      (makelay (setq acadin-hlay (rdef)))
      (makelay (setq acadin-attr3lay (rdef)))
      (makelay (setq acadin-attr4lay (rdef)))
      (makelay (setq acadin-attr5lay (rdef)))
    )
    (progn
      (setq acadin-blk nil)
      (setq acadin-testmc nil)
    )
  )
  (command "CLAYER" acadin-blay)
)
;;;------------------------------------------------------------------------
(defun rdef ( / def)
  (setq def (read acadin-zl))
  (setq acadin-zl (substr acadin-zl (+ 4 (strlen def))))
  def
)
;;;------------------------------------------------------------------------
(defun ederr (s)
  (if s
    (princ (strcat "\nFehler " s "\nProgramm nach " (itoa pktanz) "Punkten abgebrochen"))
  )
  (setvar "CMDECHO" echo)
  (setvar "OSMODE" osm)
  (setvar "FILEDIA" fdia)
  (close krddat)
  (setq *error* acadin-olderr)
  (princ)
)
;;;------------------------------------------------------------------------
(defun cheig ( / elist)
  (setq elist (entget (entlast)))
  (entmod (subst (cons 8 acadin-blay) (assoc 8 elist) elist))
  (entupd (entlast))

  
  (if (> acadin-attranz 0)
    (progn
      (setq elist (entget (entnext (cdar elist))))
      (entmod (subst (cons 8 acadin-pnlay) (assoc 8 elist) elist))
      (entupd (entlast))
    )
  )
  
  (if (> acadin-attranz 1)
    (progn
      (setq elist (entget (entnext (cdar elist))))
      (entmod (subst (cons 8 acadin-hlay) (assoc 8 elist) elist))
      (entupd (entlast))
    )
  )

  (if (> acadin-attranz 2)
    (progn
      (setq elist (entget (entnext (cdar elist))))
      (entmod (subst (cons 8 acadin-attr3lay) (assoc 8 elist) elist))
      (entupd (entlast))
    )
  )

  (if (> acadin-attranz 3)
    (progn
      (setq elist (entget (entnext (cdar elist))))
      (entmod (subst (cons 8 acadin-attr4lay) (assoc 8 elist) elist))
      (entupd (entlast))
    )
  )

  (if (> acadin-attranz 4)
    (progn
      (setq elist (entget (entnext (cdar elist))))
      (entmod (subst (cons 8 acadin-attr5lay) (assoc 8 elist) elist))
      (entupd (entlast))
    )
  )
)
;;;------------------------------------------------------------------------
(defun no1bl (string)
  (While (= " " (substr string 1 1))
    (setq string (substr string 2))
  )
  string
)
;;;------------------------------------------------------------------------
(defun nobl (string / c newstr tmpstr)
   (setq c 1)
   (setq newstr "")
   (repeat (strlen string)
      (setq tmpstr (substr string c 1))
      (if (/= (ascii tmpstr) 32)
        (setq newstr (strcat newstr tmpstr))
      )
      (setq c (1+ c))
   )
   newstr
)
;;;------------------------------------------------------------------------
(defun acadincfg ( / cfgdes neulad zle)
;;; Messcode-Def. laden----------------
  (if acadin-mcdef
    (progn
      (princ (strcat "\nMesscode-Definitionsdatei: " acadin-mcdef))
      (initget "Nein Ja")
      (setq neulad (getkword "\nNeue Messcode-Definitionsdatei laden J/N <N>:"))
      (if (= neulad "Ja")
        (setq neulad T)
        (setq neulad nil)
      )
    )
    (setq neulad T)
  )
  (if neulad
;;; Die nachfolgende Zeile wurde auskommentiert, kann aber anstelle der
;;; übernächsten Zeile verwendet werden - ev. Pfad anpassen
;;;    (setq acadin-mcdef (getfiled "Messcode-Definitions-Datei auswählen" "c:/acadin/" "def" 4))   ; Pfad anpassen
    (setq acadin-mcdef (getfiled "Messcode-Definitions-Datei auswählen" "" "def" 4))                ; Pfad anpassen
  )
;;; Nachfolgende if-Funktion kann dazu benutzt werden, eine Default-Datei zu verwenden
;;;  (if (not acadin-mcdef)
;;;    (setq acadin-mcdef "c:/acadin/acadin-mc.def")        ;bei Verwendung Pfad anpassen
;;;  )
  (if (not acadin-mcdef)
    (ederr "\nKeine Messcode-Definitionsdatei-Datei ausgewählt !")
  )

;;; Ascii-Def. laden-------------------
  (if cfgdatei
    (progn
      (princ (strcat "\nAscii-Definitionsdatei: " cfgdatei))
      (initget "Nein Ja")
      (setq neulad (getkword "\nNeue Ascii-Definitionsdatei laden J/N <N>:"))
      (if (= neulad "Ja")
        (setq neulad T)
        (setq neulad nil)
      )
    )
    (setq neulad T)
  )
  (if neulad
;;; Die nachfolgende Zeile wurde auskommentiert, kann aber anstelle der
;;; übernächsten Zeile verwendet werden - ev. Pfad anpassen
;;;    (setq cfgdatei (getfiled "Ascii-Definitions-Datei auswählen" "c:/acadin/" "def" 4))
    (setq cfgdatei (getfiled "Ascii-Definitions-Datei auswählen" "" "def" 4))
  )
;;; Nachfolgende if-Funktion kann dazu benutzt werden, eine Default-Datei zu verwenden
;;;  (if (not cfgdatei)
;;;    (setq cfgdatei "c:/acadin/acadin-ascii.def")        ;bei Verwendung Pfad anpassen
;;;  )
  (if (not cfgdatei)
    (ederr "\nKeine Ascii-Definitionsdatei-Datei ausgewählt !")
  )
;;; Ascii-Def. lesen-------------------
  (if cfgdatei
    (progn
      (setq cfgdes (open cfgdatei "r")
            zle           (read-line cfgdes)
            acadin-pktanf (atoi (substr zle 1 3))
      )
      (setq zle          (read-line cfgdes)
            acadin-pktlg (- (atoi (substr zle 1 3)) acadin-pktanf)
      )
      (setq zle          (read-line cfgdes)
            acadin-yanf  (atoi (substr zle 1 3))
            zle          (read-line cfgdes)
            acadin-ylg          (- (atoi (substr zle 1 3)) acadin-yanf)
            zle          (read-line cfgdes)
            acadin-xanf  (atoi (substr zle 1 3))
            zle          (read-line cfgdes)
            acadin-xlg          (- (atoi (substr zle 1 3)) acadin-xanf)
            zle          (read-line cfgdes)
            acadin-hanf  (atoi (substr zle 1 3))
            zle          (read-line cfgdes)
            acadin-hlg          (- (atoi (substr zle 1 3)) acadin-hanf)
            zle          (read-line cfgdes)
            acadin-mcanf (atoi (substr zle 1 3))
            zle          (read-line cfgdes)
            acadin-mclg  (- (atoi (substr zle 1 3)) acadin-mcanf)
          zle (read-line cfgdes)
         acadin-attr3anf (atoi (substr zle 1 3))
         zle   (read-line cfgdes)
         acadin-attr3lg  (- (atoi (substr zle 1 3)) acadin-attr3anf)
         zle (read-line cfgdes)
         acadin-attr4anf (atoi (substr zle 1 3))
         zle   (read-line cfgdes)
         acadin-attr4lg  (- (atoi (substr zle 1 3)) acadin-attr4anf)
         zle (read-line cfgdes)
         acadin-attr5anf (atoi (substr zle 1 3))
         zle   (read-line cfgdes)
         acadin-attr5lg  (- (atoi (substr zle 1 3)) acadin-attr5anf)
      )
      (close cfgdes)
    )
    (ederr "\nKeine Ascii-Definitionsdatei ausgewählt !")
  )
)
;;;------------------------------------------------------------------------
(defun makelay (lay)
  (if (/= "" lay)
    (if (not (tblsearch "LAYER" lay))
      (progn
        (if (= "" (setq farbe (getstring (strcat "\nFarbe für Layer " lay " eingeben: <1>"))))
          (setq farbe "1")
        )
        (command "_.LAYER" "_M" lay "_C" farbe lay "")
      )
    )
  )
)
;;;------------------------------------------------------------------------
(princ "\nStarten mit ACADIN")
(princ)
;;;****************************************************************************