;;;
;;; BAEI.lsp 1.9 [Block Attribut Export Import] getestet unter AutoCAD 2002, müßte ab R12 laufen.
;;; Datum: 12.12.2002
;;; eduaotto@gmx.de
;;;
;;; Beschreibung: Das Programm exportiert alle Block-Attribute des Modell-Bereichs
;;;               einer Zeichnung in eine Text-Datei im CSV Format (alle Werte werden durch
;;;               ein Semikolon getrennt). Diese Datei kann von Excel spaltenweise eingelesen
;;;               werden. Bitte die Datei nicht mit Doppelklick oder "drag and drop" öffnen,
;;;               sondern über den normalen Dialog, da Excel erst Information über das in der
;;;               Datei verwendete Trennzeichen braucht. Bitte "Semikolon" als Trennzeichen angeben,
;;;               und " als Texterkennungszeichen. Diese Informationen für Dateien mit der
;;;               Endung ".csv" merkt sich Excel, so das sie nur einmal angegeben werden müssen.
;;;               Nach dem Öffnen der Datei die Spalten oder das ganze Arbeitsblatt markieren
;;;               und auf optimale Breite setzen, in Excel 7.0 geht das im Pulldown-Menü
;;;               "Format", dort "Spalte" wählen, dann "Optimale Breite".
;;;
;;;               Jeder Blocktyp bekommt eine eigene mit dem Blocknamen und der Erweiterung
:::               " / Block-Name" am Anfang gekennzeichnete Titelzeile. Nach dem Blocknamen
;;;               folgen "AutoCAD-ID", "Block-Einfügepunkt", "Block-Layer" und dann die
;;;               Attribut-Bezeichner in der Reihenfolge ihrer Erstellung.
;;;               Jeder Blockname erhält einen Punkt als Zusatz angehängt, damit die Reihenfolge
;;;               "Titelzeile, Datenzeile ... Datenzeile" für jeden Blocktyp beim Sortieren
;;;               hergestellt behalten werden kann. Die Option "Liste enthält ... keine
;;;               Überschriften" muß dafür aktiv sein.
;;;               Der AutoCAD-ID wird ein Punkt vorangestellt um zu verhindern, das Excel
;;;               bestimmte Zeichenkombinationen beim einlesen als Exponential-Zahl interpretiert.
;;;               Ebenso erhalten die Layer-Namen einen Punkt vorangestellt damit auch Layer-Namen
;;;               mit einem "-" als erstes Zeichen von Excel problemlos eingelesen werden können.
;;;               Eine Blockeinfügepunkt-Koordinate kann nach dem kopieren mit "Strg+v" direkt
;;;               in AutoCAD in einem gerade aktiven Befehl eingefügt und verwendet werden.
;;;
;;;               Die Daten werden alphabetisch nach Blocknamen sortiert in die Exportdatei
;;;               geschrieben. Die Blocknamen in den Titelzeilen werden groß geschrieben,
;;;               die in den Datenzeilen klein.
;;;
;;;               Die Reihenfolge der Spalten darf in Excel nicht verändert werden, da die
;;;               Import-Funktion auf sie abgestimmt ist.
;;;
;;;               Solange das Programm arbeitet, zeigt ein sich drehender Strich die Programm-
;;;               aktivität in der Kommandozeile an, nach Ablauf des Programms wird die Anzahl
;;;               der bearbeiteten Blöcke und die Bearbeitungs-Zeit ausgegeben.
;;;
;;;               Der Dateiname der Attribut-Export-Datei setzt sich zusammen
;;;               aus dem Zeichnungsnamen und dem Zusatz ".exp.csv".
;;;
;;;               Beispiel: Attribut-Test.dwg.exp.csv
;;;
;;;
;;;               Nach Änderung der Attributwerte mit Excel muss die Import-Datei
;;;               für die Zeichnung wieder im "CSV"-Format gespeichert werden (die
;;;               Daten der einzelnen Datensätze müssen durch ein Semikolon getrennt sein).
;;;               Der Name der Import-Datei muß sich zusammensetzen aus dem Zeichnungsnamen
;;;               und der Endung ".imp.csv".
;;;
;;;               Beispiel: Attribut-Test.dwg.imp.csv
;;;
;;;
;;; Sonstiges:    Globale Variablen sind mit "#" gekennzeichnet.
;;;               Funktionen sind mit "ATT:" oder "std-" gekennzeichnet.
;;;
;;; -----------------------------------------------------------------------------------------------
;;; Programm-Befehle:
;;; ATTOUT        Der Befehl ATTOUT exportiert die Blockattribute aus der Zeichnung
;;;               in die Datei "<Zeichnungsname>.exp.csv" in das Verzeichnis der
;;;               Zeichnung.
;;; ATTIMP        Der Befehl ATTINP importiert die Blockattribute aus der Datei
;;;               "<Zeichnungsname>.imp.csv" in die Zeichnung.
;;;               Die Importdatei muß sich im Verzeichnis der Zeichnung befinden.
;;;
;;; IDFIND        Der Befehl IDFIND fragt nach der AutoCAD-ID eines Blockes im Modell-Bereich
;;;               und zoomt anschließend auf den Block. Er zeichnet zwei lila-farbene
;;;               gestrichelte Linien die sich im Einfügepunkt des Blockes kreuzen.
;;;               Diese Linien sind nur temporär sichtbar und werden nicht dauerhaft
;;;               in die Zeichnung eingefügt. Ruft man den Befehl noch einmal auf und drückt
;;;               einfach die <ENTER> Taste wird die Markierung wieder entfernt.
;;;
;;;------------------------------------------------------------------------------------------------
;;;
;;STRPARSE FOR PARSING STRING (and keeping null tokens)
(defun ATT:strparse(strng chs / len c l s chsl cnt );;delim==one-of-chs.
  (setq chsl (ATT:strtol chs))
  (setq len (strlen strng) s "" cnt (1+ len))
  (while (> (setq cnt (1- cnt)) 0)
    (setq c (substr strng cnt 1))
    (if (member c chsl)
      (if (/= cnt len);; "1;2;" -> ("1" "2") and not ("1" "2" "")
        (setq l (cons s l) s "")
      )
      (setq s (strcat c s))
    )
  )
  (cons s l)   ;; ";1;2" -> ("" "1" "2")
)
;; strtol convert string of chars into list of 1-char strings
(defun ATT:strtol ( s / lst c )
  (repeat (setq c (strlen s))
    (Setq lst (cons (substr s c 1) lst)
          c   (1- c)
  ))
  lst
)
;;;------------------------------------------------------------------------------------------------
;;;
;;; eg (sublist 1 2 '(1 2 3 4 5)) = (2 3)
(defun ATT:sublist (f_n f_m f_newlist / f_loop f_x)
                                        ;returns sublist of a list, similar to substr function
  (if (>= (length f_newlist) f_n)       ;test range
    (progn
      (setq f_loop -1)                  ;initialize counter
      (setq f_m (+ f_n (- f_m 1)))      ;setq end element
      (foreach f_x f_newlist            ;loop through list
        (progn
          (setq f_loop (1+ f_loop))     ;increment counter
          (if (and (<= f_n f_loop) (>= f_m f_loop)) ;check within range
            (setq f_newlist (cdr (append f_newlist (list f_x))))
                                        ;move first element to end of list
            (setq f_newlist (cdr f_newlist)) ;remove first element
          ) ;_ if
        ) ;_ progn
      ) ;_ foreach
    ) ;_ progn
  ) ;_ if
) ;_ defun
;;;------------------------------------------------------------------------------------------------
;;;
(defun ATT:parse_time
       (cdate / date_str year month day hour minutes secs date)
  (if cdate
    (setq date_str (rtos cdate 2 10)
          year     (substr date_str 3 2)
          month    (substr date_str 5 2)
          day      (substr date_str 7 2)
          hour     (substr date_str 10 2)
          minutes  (substr date_str 12 2)
          secs     (substr date_str 14 2)
          date     (strcat day "." month "." year "  " hour ":" minutes
                           ":" secs) ;_ strcat
    ) ;_ setq
  ) ;_ if
) ;_ defun
;;;------------------------------------------------------------------
;;;
(defun ATT:start_timer ()
  (setq deleted 0
        c_date  (getvar "cdate")
        s_date  (getvar "tdusrtimer")
        dwg     (getvar "dwgname")
  ) ;_ setq
  (princ (strcat "\nBeginne Bearbeitung der Zeichnung "
                 dwg
                 " am "
                 (ATT:parse_time c_date)
                 "\n"
         ) ;_ strcat
  ) ;_ princ
  (princ)
) ;_ defun
;;;------------------------------------------------------------------
;;;
(defun ATT:stop_timer ()
  (setq e_date (getvar "tdusrtimer")
        t_secs (* 86400.0 (- e_date s_date))
        hrs    (fix (/ t_secs 3600.0))
        mns    (fix (/ (- t_secs (* hrs 3600.0)) 60.0))
        secs   (- t_secs (+ (* hrs 3600.0) (* mns 60.0)))
  ) ;_ setq
  (princ "Bearbeitungs-Zeit: ")
  (if (> hrs 0.0)
    (princ (strcat (itoa hrs)
                   " Stunde"
                   (if (> hrs 1)
                     "n"
                     ""
                   ) ;_ if
                   ", "
           ) ;_ strcat
    ) ;_ princ
  ) ;_ if
  (if (> mns 0.0)
    (princ (strcat (itoa mns)
                   " Minute"
                   (if (> mns 1)
                     "n"
                     ""
                   ) ;_ if
                   ", "
           ) ;_ strcat
    ) ;_ princ
  ) ;_ if
  (princ (strcat (rtos secs 2 3) " Sek."))
  (princ)
) ;_ defun
;;;------------------------------------------------------------------
;;;
;;; CONSP  - a not empty list
(defun ATT:consp (x) (and x (listp x)))
;;;------------------------------------------------------------------
;;;
;;; DXF  - return the DXF group code of an (entget) list
(defun ATT:dxf (grp ele) (cdr (assoc grp ele)))
;;;------------------------------------------------------------------
;;;
;;; use merge-sort for everything (STD-STABLE-SORT List '<)
(defun ATT:STD-STABLE-SORT (lst cmp)
  (std-%merge-sort lst cmp)
) ;_ defun
;;;---------------------
;;;
(defun std-merge (l1 l2 cmp / cl1 cl2 lst)
  (setq cl1 (car l1)
        cl2 (car l2)
        lst nil
  )                                     ; possible VL lsa compiler bug
  (while (and l1 l2)
    (if (apply cmp (list cl2 cl1))
      (setq lst (cons cl2 lst)
            l2  (cdr l2)
            cl2 (car l2)
      ) ;_ setq
      (setq lst (cons cl1 lst)
            l1  (cdr l1)
            cl1 (car l1)
      ) ;_ setq
    ) ;_ if
  ) ;_ while
  (append (reverse lst) l1 l2)
) ;_ defun
;;;---------------------
;;;
;;; STD-SPLIT-LIST splits list into sublists of maximal length n
;;; n must be > 0!
;;; Iterative version by Serge Pashkov, safer than recursive version
;;;   (std-split-list 2 '(1 2 3 4 5 6)) => ((1 2) (3 4) (5 6))
(defun STD-SPLIT-LIST (n lst / cnt out ret)
  (setq ret nil)                        ; possible VL lsa compiler bug
  ;; adjust cnt to set incomplete number of elements (if any) for the
  ;; last segment
  (setq cnt (- n (rem (length lst) n))
        lst (reverse lst)
  ) ;_ setq
  (while lst
    (setq ret (cons (car lst) ret)
          lst (cdr lst)
    ) ;_ setq
    (if (zerop (rem (setq cnt (1+ cnt)) n))
      (setq out (cons ret out)
            ret nil
      ) ;_ setq
    ) ;_ if
  ) ;_ while
  (if ret
    (cons ret out)
    out
  ) ;_ if
) ;_ defun
;;;---------------------
;;;
;;; stable insertion sort, fast for already ordered and short lists
;;; very slow for reversed or random lists O(n^2)
;;; by Serge Pashkov
(defun std-%insertion-sort (lst cmp / cO M N O)
  (setq O (reverse lst)
        M nil
        N (list (car O))
  ) ;_ setq
  (while (setq O (cdr O))
    (setq cO (car O))
    (while (and N (apply cmp (list (car N) cO)))
      (setq M (cons (car N) M)
            N (cdr N)
      ) ;_ setq
    ) ;_ while
    (setq N (cons cO N))
    (while M
      (setq N (cons (car M) N)
            M (cdr M)
      ) ;_ setq
    ) ;_ while
  ) ;_ while
  N
) ;_ defun
;;;---------------------
;;;
;;; Non-recursive stable merge sort
;;; Overall the best method in AutoLISP. By Serge Pashkov
;;; Slightly improved 3% by using Danieles trick. see std-%setnth
;;;   (setq l '((1 1) (2 1) (1 2) (3 1) (1 3) (3 2) (3 3) (4 1) (1 4)))
;;;   (std-%merge-sort l ( function (lambda (x y)(< (car x) (car y)))))
;;;     => ((1 1) (1 2) (1 3) (1 4) (2 1) (3 1) (3 2) (3 3) (4 1))
;;; It's supposed that used version of std-%insertion-sort is stable.
(defun std-%merge-sort (lst _cmp / len mlst rst)
  ;; split by short lists sorted by insertion to decrease overhead
  ;; length 4 is near optimum for sorted and random lists.
  (setq
    rst (mapcar (function (lambda (e) (std-%insertion-sort e _cmp)))
                (std-split-list 4 lst)
        ) ;_ mapcar
  ) ;_ setq
  ;; repeat while leave only 1 sequence
  (while (> (setq len (length rst)) 1)
    ;; Merge every 2 adjacent sorted sequences
    (repeat (/ len 2)
      (setq mlst (cons (std-merge (car rst) (cadr rst) _cmp) mlst)
            rst  (cddr rst)
      ) ;_ setq
    ) ;_ repeat
    ;; Add last sorted sequence (if any)
    (setq rst  (reverse (if rst
                          (cons (car rst) mlst)
                          mlst
                        ) ;_ if
               ) ;_ reverse
          mlst nil
    ) ;_ setq
  ) ;_ while
  (car rst)
) ;_ defun
;;;------------------------------------------------------------------
;;;
;;; ADJOIN - conses ele to list if not already in list
;;; trick: accepts quoted lists too, such as
;;;   (setq l '(1 2 3) (adjoin 0 'l)
;;;    -> !l (0 1 2 3)
(defun ATT:adjoin (ele lst / tmp)
  (if (= (type lst) 'SYM)
    (setq tmp lst
          lst (eval tmp)
    ) ;_ setq
  ) ;_ if
  (setq lst (cond ((member ele lst) lst)
                  (t (cons ele lst))
            ) ;_ cond
  ) ;_ setq
  (if tmp
    (set tmp lst)
    lst
  ) ;_ if
) ;_ defun
;;;------------------------------------------------------------------
;;;
;;; Prints a pinwheel on the command line
(defun ATT:Spin (msg)
  (setq #SYM
         (cond
           ((= #SYM nil) "-")
           ((= #SYM "-") "\\")
           ((= #SYM "\\") "|")
           ((= #SYM "|") "/")
           ((= #SYM "/") "-")
         ) ;_ cond
  ) ;_ setq
  (princ (strcat "\r"                 msg
                 "... "               #SYM
                 "                            "
                ) ;_ strcat
  ) ;_ princ
) ;_ defun
;;;------------------------------------------------------------------
;;;
(defun ATT:ListAttName-AttValue (lst    /      ATTLST cnt    DOTLST
                                 elem   IDX    NLST   TEMP1  TEMP2
                                 X
                                )
  (setq dotlst nil)
  (setq attlst nil)
  (setq temp1 "")
  (setq temp2 "")
  (setq nlst '())
  (setq Idx 6)
  (setq cnt 0)
  (foreach elem lst
    (if (>= cnt Idx)
      (setq nlst (cons elem nlst))
    ) ;_ if
    (setq cnt (1+ cnt))
  ) ;_ foreach
  (setq nlst (reverse nlst))
  ;;
  (setq cnt 0)
  (foreach x nlst
    (setq cnt (1+ cnt))
    (if (= cnt 1)
      (setq temp1 x)
    ) ;_ if
    (if (= cnt 2)
      (setq temp2 x)
    ) ;_ if
    (if (= cnt 2)
      (progn
        (setq dotlst (cons temp1 temp2))
        (setq attlst (append attlst (list dotlst)))
        (setq temp1 "")
        (setq temp2 "")
        (setq cnt 0)
      ) ;_ progn
    ) ;_ if
  ) ;_ foreach
  attlst
) ;_ defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------------------------------------------------
;;; Listing 1. Extracting all blocks containing attributes to a text file,
;;; including the block name and the block handle with the data.
;;;
(defun C:ATTEXP
                (/      ATTS   BN     BN0    BN_LST1
                 BN_LST2       BPOS   CNT    CNT1
                 DELIM  EH     EL     EL0    EN     EN0    FH
                 FN     LAYER  LN     SS1
                )
  ;; Handles are typically on in R13, but could
  ;; be off in R12.
  (if (/= (getvar "HANDLES") 1)
    (command "_HANDLES" "_ON")
  ) ;_ if
  ;;
  ;; build a selection set of all inserts in model-space with
  ;; attributes.
  (setq SS1
         (ssget
           "X"
           '((0 . "INSERT") (66 . 1) (410 . "Model"))
         ) ;_ ssget
  ) ;_ setq
  ;;
  ;; if inserts found with attributes, build
  ;; report file.
  (if SS1
    (progn
      (ATT:start_timer)
      (setq FN    (strcat (getvar "DWGPREFIX") (getvar "DWGNAME") ".exp.csv")
            CNT   (fix(sslength SS1))
            CNT1  CNT
            delim ";"                   ; delimiter
      ) ;_ setq
      (if (setq FH (open FN "w"))
        (princ)
        (progn
          (alert
            (strcat "Export nicht möglich, Datei offen, bitte schließen !"
                    "\n\n"
                    FN
            ) ;_ strcat
          ) ;_ alert
          (exit)
        ) ;_ progn
      ) ;_ if
      (setq BN_LST3 nil)
      (repeat CNT1
        (ATT:spin "Sortiere Blöcke")
        (setq CNT1 (1- CNT1)
              EN   (ssname SS1 CNT1)
              EL   (entget EN)
              BN   (cdr (assoc 2 EL)) ;Block-Name
              BL   (cdr (assoc 8 EL)) ;Block-Layer
        ) ;_ setq
        (setq BN_LST1 (ATT:adjoin (strcase BN ) BN_LST1))
        (setq BN_LST2 (ATT:adjoin (cons (strcase BN) EN) BN_LST2))
      ) ;_ repeat
      (setq BN_LST1 (ATT:std-stable-sort BN_LST1 '<))
      (setq BN_LST2 (ATT:std-stable-sort
                      BN_LST2
                      (function (lambda (x y) (< (car x) (car y))))
                    ) ;_ std-stable-sort
      ) ;_ setq
      ;;(print bn_lst2)
      (foreach bn BN_LST1
        ;;------------------------------
        (ATT:spin "Exporting to file")
        (setq bn0 (car (nth 0 BN_LST2)))
        (setq en0 (cdr (nth 0 BN_LST2)))
        (setq ATTS (ATT:GETS en0)
              ;;start output line for headline
              LN   (strcat
                     (chr 34)
                     (strcase BN )      ;Block-Name
                     " / "
                     "Block-Name"
                     (chr 34)
                     delim
                     (chr 34)
                     "AutoCAD-ID"
                     (chr 34)
                     delim
                     (chr 34)
                     "Block-Einfügepunkt X,Y,Z"
                     (chr 34)
                     delim
                     (chr 34)
                     "Block-Layer"
                     (chr 34)
                     (apply
                       'strcat
                       (mapcar
                         '(lambda (A)
                            (strcat
                              delim
                              (chr 34)
                              (car A)   ; Attribut-Name
                              (chr 34)
                            ) ;_ strcat
                          ) ;_ lambda
                         ATTS
                       ) ;_ mapcar
                     ) ;_ apply
                   ) ;_ strcat
        ) ;_ setq
        (write-line LN FH)
        ;;------------------------------
        (while (and BN_LST2 (= bn bn0))
          (setq EN0 (cdr (nth 0 BN_LST2)))
          (setq EL0 (entget en0))
          (setq ATTS     (ATT:GETS en0)
                EH       (ATT:dxf 5 EL0)
                layer    (ATT:dxf 8 EL0)
                blkeinfp (ATT:dxf 10 EL0)
                ;;start output line for data
                LN    (strcat
                        ;;Block-Name
                        (chr 34)
                        (strcase (ATT:dxf 2 EL0) 1)        ; Block-Name
                        ;; angehängter Punkt dient als Sortierhilfe für Excel
                        "."
                        (chr 34)
                        delim
                        (chr 34)
                        ;;AutoCAD-ID
                        ;;  Der AutoCAD-ID wird ein Punkt vorangestellt um zu
                        ;;  verhindern, das Excel bestimmte Zeichenkombinationen beim
                        ;;  einlesen der Datei als Zahl interpretiert und so die ID zerstört.
                        "."
                        (ATT:dxf 5 EL0) ; AutoCAD-ID
                        (chr 34)
                        delim
                        (chr 34)
                        ;;"Block-Einfügepunkt X,Y,Z"
                        (strcat (rtos(car blkeinfp))
                                ","
                                (rtos(cadr blkeinfp))
                                ","
                                (rtos(caddr blkeinfp))
                        ) ;_ strcat
                        (chr 34)
                        delim
                        ;;Block-Layer
                        ;;  Den Layer-Namen wird ein Punkt vorangestellt um zu
                        ;;  verhindern, das Excel Layer-Namen mit einem "-" als erstes Zeichen
                        ;;  beim einlesen falsch interpretiert.
                        (chr 34)
                        "."
                        layer
                        (chr 34)        ; Layer-Name
                        (apply
                          'strcat
                          (mapcar
                            '(lambda (A)
                               (strcat
                                 delim
                                 (chr 34)
                                 (cdr A) ; Attribut-Data
                                 (chr 34)
                               ) ;_ strcat
                             ) ;_ lambda
                            ATTS
                          ) ;_ mapcar
                        ) ;_ apply
                      ) ;_ strcat
          ) ;_ setq
          (write-line LN FH)
          (setq BN_LST2 (cdr BN_LST2))
          (if (ATT:consp BN_LST2)
            (setq bn0 (car (nth 0 BN_LST2)))
            (princ "\r")
          ) ;_ if
        ) ;_ while
      ;;------------------------------
      ) ;_ foreach
      (close FH)
      (princ "\r                                          \r")
      (princ
        (strcat "\rBearbeitete Blöcke: "
                (itoa (fix(sslength SS1)))
                "\n"
                "Export beendet, "   
        ) ;_ strcat
      ) ;_ princ
      (ATT:stop_timer)
    ) ;_ progn
    (alert "Keine Attribut-Blöcke gefunden !")
  ) ;_ if
) ;_ defun
;;;------------------------------------------------------------------
;;;
(defun ATT:GETS (EN / EL RES)
  (setq EN (entnext EN)
        EL (entget EN)
  ) ;_ setq
  (while (= "ATTRIB" (cdr (assoc 0 EL)))
    (setq RES (cons
                (cons (cdr (assoc 2 EL))
                      (cdr (assoc 1 EL))
                ) ;_ cons
                RES
              ) ;_ cons
          EN  (entnext EN)
          EL  (entget EN)
    ) ;_ setq
  ) ;_ while
  (reverse RES)
) ;_ defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;---------------------------------------------------------------------
;;;
;;; Listing 2. Replacing attributes in entity EN from the list ATTS.
;;; ATTS are a sequential list of strings.
;;;
(defun ATT:REPLACE (EN ATTS / A ATT EL OLD WERT WERT1 WERT2)
  (if (atom (car ATTS))
    ;;update sequential
    (foreach ATT ATTS
      (setq EN (entnext EN)
            EL (entget EN)
            EL (subst (cons 1 ATT)
                      (assoc 1 EL)
                      EL
               ) ;_ subst
      ) ;_ setq
      (entmod EL)
    ) ;_ foreach
  ) ;_ if
  (entupd EN)
) ;_ defun
;;;------------------------------------------------------------------
;;;
;;; Listing 3. A routine to read the .imp.csv text file and update the
;;; insert entities defined by the handle name. The .imp.csv file format is
;;; same as .exp.csv file except for supporting lists containing tags and values.
;;;
(defun C:ATTIMP
       (/ blkcnt ATTLST EN FH FN HNDL nlst lenATT newLN lenLN LN)
  (setq blkcnt 0)
  (setq FN (strcat (getvar "DWGPREFIX") (getvar "DWGNAME") ".imp.csv")
        FN (findfile FN)
  ) ;_ setq
  (if FN
    (progn
      (ATT:start_timer)
      (setq FH (open FN "r"))
      (setq LN (read-line FH))
      (while (/= LN nil)
        (setq LN   (ATT:strparse LN ";")
              HNDL (cadr LN)
        ) ;_ setq
        ;; falls Attribut-Name und -Wert paarweise vorliegen
        ;; und eine Liste bilden sollen
        ;;(setq attlst (ListAttName-AttValue (cddr LN)))
        ;;(ATT:REPLACE EN attlst)
        (if (and (/= (nth 1 LN) "AutoCAD-ID") (ATT:consp LN))
          (progn
            (setq blkcnt (1+ blkcnt))
            (setq nlst '())
            (setq LN (cddddr LN))
            (setq EN (substr HNDL 2))
            (setq EN (handent EN))
            ;;-----------------------------------
            ;; Attribute und Datensatz abgleichen
            (setq lenATT (length (ATT:GETS EN)))
                                        ; Anzahl der Attribute ermitteln
            (setq lenLN (length LN))    ; Anzahl der Daten ermitteln
            (if (< lenATT lenLN)
              (setq newLN (ATT:sublist 0 lenATT LN))
              (setq newLN LN)
            ) ;_ if
            (if (> lenATT lenLN)
              (progn
                (repeat (- lenATT lenLN)
                  (setq newLN (append newLN (list "")))
                ) ;_ repeat
              ) ;_ progn
            ) ;_ if
            ;;-----------------------------------
            (ATT:REPLACE EN newLN)
          ) ;_ progn
        ) ;_ if
        (ATT:spin "Importiere Attribute")
        (setq LN (read-line FH))
      ) ;_ while
      (close FH)
      (princ "\r                                          \r")
      (princ
        (strcat "\rBearbeitete Blöcke: "
                (itoa blkcnt)
                "\n"
                "Import beendet, "   
        ) ;_ strcat
      ) ;_ princ
      (ATT:stop_timer)
    ) ;_ progn
    (alert (strcat "Datei nicht gefunden !\n\n"
                   (getvar "DWGPREFIX")
                   (getvar "DWGNAME")
                   ".imp.csv"
           ) ;_ strcat
    ) ;_ alert
  ) ;_ if
) ;_ defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;------------------------------------------------------------------
;;;
(defun C:IDFIND ( / B-EINFP B-ID BN C CNT DWGSCAL EH EL EN FLAG PT1
                   PT2 SS1
                )
  ;;---------------------------------------------------------------
  ;; dwgscal: mit dieser Variable kann man den Zoom-Faktor steuern,
  ;; ein größerer Wert entfernt das Objekt vom Betrachter,
  ;; ein kleinerer Wert holt das Objekt näher zum Betrachter.
  (setq dwgscal 2)                      ; Standard-Wert ist 2
  ;;---------------------------------------------------------------
  (princ "\n   <ENTER> entfernt das Block-Markierungskreuz\n")
  (setq b-id (strcase
               (getstring
                 "Bitte AutoCAD-ID des gesuchten Blocks eingeben: "
               ) ;_ getstring
             ) ;_ strcase
  ) ;_ setq
  (setq SS1
         (ssget
           "X"
           '((0 . "INSERT") (66 . 1) (410 . "Model"))
         ) ;_ ssget
  ) ;_ setq
  (if (and SS1 (/= b-id ""))
    (progn
      (if (= (substr b-id 1 1) ".")
        (setq b-id (substr b-id 2))
      ) ;_ if
      (setq CNT  (fix(sslength SS1))
            c    0
            flag nil
      ) ;_ setq
      (while (and (= flag nil) (/= c CNT))
        (ATT:spin (strcat "Suche Block-ID " b-id " ..."))
        (setq EN (ssname SS1 c)
              EL (entget EN)
              BN (ATT:dxf 2 EL)
              EH (strcase (ATT:dxf 5 EL))
        ) ;_ setq
        (if (= b-id EH)
          (setq flag 1)
          (setq c (1+ c))
        ) ;_ if
      ) ;_ while
      (if flag
        (progn
          (princ (strcat "\rBlock-ID \"" b-id "\" gefunden."))
          (setq b-einfp (ATT:dxf 10 EL)
                pt1     (list (- (car b-einfp) (* 50.0 dwgscal))
                              (- (cadr b-einfp) (* 50.0 dwgscal))
                        ) ;_ list
                pt2     (list (+ (car b-einfp) (* 50.0 dwgscal))
                              (+ (cadr b-einfp) (* 50.0 dwgscal))
                        ) ;_ list
          ) ;_ setq
          (command "_.zoom" "_w" pt1 pt2)
          (redraw)
          (grvecs (list -201
                        pt1 pt2
                        (list (car pt2) (cadr pt1))
                        (list (car pt1) (cadr pt2))
                  ) ;_ list
          ) ;_ grvecs
          (princ (strcat "\nBlock-ID: " EH ",  Block-Name: " BN ",  Einfügepunkt: "))
          (princ b-einfp)
        ) ;_ progn
        (progn
          (princ (strcat "\rBlock-ID \"" b-id "\" nicht gefunden."))
          (alert (strcat "\nBlock-ID nicht gefunden!\n\n" b-id))
        )
      ) ;_ if
    ) ;_ progn
    (progn
      (redraw)
      (prompt "IDFIND nicht ausgeführt, Block-Markierungskreuz (wenn vorhanden) entfernt.")
    )
  ) ;_ if
  (princ)
) ;_ defun
;;
(princ "\nAttribute exportieren, importieren.")
(princ "\nExport mit ATTEXP, Import mit ATTIMP, Block finden mit IDFIND.")
(princ)