Wer kann mir beim AutoLisp helfen? (Autodesk/Lisp)

Hallo Holger!
Erst mal recht herzlichen Dank für deine Antwort! Ich habe wie du mir gesagt hast die Lisp-Datei als Quellcode angefügt, leider kann ich nicht sagen ob es komplett ist da, ich es nur eingefügt habe. Aus sicherheit hab ich die Text-Datei auch als Datei angehängt.
Es wäre ganz nett von dir wenn du mir bei meinen Problem helfen könntest, werde auch natürlich das Vorum nach ähnlichen Antworten durchsuchen.
Also hier der Quellcode:

TRANSFER Version 1.0 18.3.1993
;
; Nach der Initialisierung, die versch. globale Einstellungen konfiguriert und
; die nötigen Layer anlegt, werden aus einer Datei, die einzelne Punkte und
; die zugehörigen Punktnummern enthält diese gelesen und in die aktuelle Auto-
; CAD Zeichnung eingesetzt; gleichzeitig werden auf korresp. Layern Kontroll
; blöcke mit den entspr. Punktbezeichnungen eingesetzt.
; Die Datei muss dabei folgendes Aussehen haben:
; X-Koord1,Y-Koord1,Bez. auf Layer1,Bez. auf Layer2, ....
; X-Koord2,Y-Koord2,Bez. auf Layer1,Bez. auf Layer2, ....
; .....
; Frei konfigurierbar sind dabei
; Trennzeichen 'trenn'
; Anzahl der Layer 'layer_anz'
; Bez. für nicht belegten Layer 'blank'
; Änderungen wer wann was
; HH&HS 18.3.93 Version 1.0 & very hard testing
;*****************************************************************************
(princ "\nTRANSF1 v1.0
(princ "\nLaden .")

(defun C:INIT ( / i lnam llist)

;****************** KONFIGURATION *******************************************
;legt die Einstellungen f. die Übertragung fest; feel free to edit (if u know)

(setq offset '(36 157.69)) ;Nullpunkt der Fläche
;

;LAYER der Namen setzt sich zusammen aus Prefix,lfd. Nummer und Postfix
; z.B: Nummer1 ... Nummer2, Nummer1Z ... Nummer2Z,
(setq layer_anz 4) ;Anzahl der Layer
(setq layerpref "Masch_") ;Prefix des Layernamens
(setq layerpost "z") ;Postfix -"-

(setq blockname "Nummer von oben") ;Block zur Kontrolle auf den -z Layer
;ACHTUNG: muss im aktuellen Verzeichnis exist.

(setq trenn ",") ;Trennzeichen zwischen records
(setq blank 0) ;kein Eintrag

(setq startdir "C:\Textfiles") ;Vorgabe beim Koordfile wählen
(setq koordext "TXT") ;Extension f.d. Koordinatenfiles

(setq prlist '(| \ - /)) ;funny little list
;*****************************************************************************
(setq ocmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)

(setq i 1)
(while (<= i layer_anz)
(if (= i 1)
(setq llist (setq lnam (strcat layerpref (itoa i))))
(setq llist (strcat llist "," (setq lnam (strcat layerpref (itoa i)))))
)
(setq llist (strcat llist "," (strcat lnam layerpost)))
(setq i (1+ i))
)
(command "LAYER" "n" llist "")
(setq i 1)
(while (<= i layer_anz)
(command "LAYER" "fa" i (strcat layerpref (itoa i) "*") "")
(setq i (1+ i))
)
'fertig
)

(princ ".")

(defun C:TRANSFER ()

(setq oosmode (getvar "OSMODE"))

(setq oucsicon (getvar "UCSICON"))
(setq oclayer (getvar "CLAYER"))

(setvar "OSMODE" 0)
(setvar "UCSICON" 2)

(setq asck (ascii "."))
(setq asct (ascii trenn))
(setq error nil)
(setq eof nil)
(setq j 0)

(setq mstatus (+ 2 layer_anz))
(command "BKS" "w")
(command "BKS" "ur" offset)
(command "BKS" "x" 180)

(if layer_anz
(progn
(setq datei (getfiled "Koordinatendatei wählen" startdir koordext 4))
(if datei
(if (setq f (open datei "r"))
(progn
(setq status 0)
(setq n 0)
(setq error nil)
(princ "\nÜbertragung läuft: ")
(while (and (not error) (not eof))
(if (= status mstatus) (setq status 1) (setq status (1+ status)))
(setq pkoord nil)
(cond
((= status 1)
(if (setq pkoord (lies-zahl nil))
(setq plist (list pkoord))
(setq error T)
)
(if eol
(setq error T)
(progn
(if (and eof (/= str ""))
(setq error T)
)
)
)
)
((= status 2)
(if (and (setq pkoord (lies-zahl nil)) (not eol) (not eof))
(setq plist (reverse (cons pkoord plist)))
(setq error T)
)
)
((<= status mstatus)
(if (= status mstatus)
(progn
(setq n (1+ n))
(if (not (and (setq attrib (lies-zahl T)) (or eof eol)))
(setq error T)
(if (and eof (= "" str))
(setq error T)
)
)
)
(if (not (and (setq attrib (lies-zahl T)) (not eol) (not eof)))
(setq error T)
)
)
(if (/= attrib 0)
(progn
(setvar "CLAYER" (setq lnam (strcat layerpref (itoa (- status 2)))))
(command "PUNKT" plist)
(setvar "CLAYER" (strcat lnam layerpost))
(command "EINFÜGE" blockname plist "1" "1" "0" attrib)
(if (= (rem n 5) 0)
(progn
(princ "\010")
(princ (nth j prlist))
(if (= j (1- (length prlist))) (setq j 0) (setq j (1+ j)))
)
)
)
)
)
)
)
(if error
(progn
(princ "\007\nFehler beim Lesen der Datei '")
(princ datei)
(princ "' in der Zeile ")
(princ n)
(princ ".\n")
)
)
(close f)
)
(progn
(princ "\007\nDie Koordinatendatei '")
(princ (strcase datei))
(princ "' kann nicht geöffnet werden.\n")
(setq error T)
)
)
(progn
(princ "\007\nKeine Datei ausgewählt.\n")
(setq error T)
)
)
(if error
(alert "ABBRUCH: Es wurden keine Daten übertragen!")
(progn
(princ "\010 Anzahl der übertragenen Punkte: ")
(princ n)
(princ "\n")
)
)
(command "BKS" "w")
(setvar "CMDECHO" ocmdecho)
(setvar "UCSICON" oucsicon)
(setvar "OSMODE" oosmode)
(setvar "CLAYER" oclayer)
'fertig
)
(alert "ABBRUCH: Transfer ist noch nicht initialisiert!")
)
)

(princ ".")

(defun lies-zahl (ganz)
(setq komma ganz)
(setq done nil)
(setq error nil)
(setq eol nil)
(setq eof nil)
(setq str "")
(while (not done)
(setq c (read-char f))
(cond
((and (<= (ascii "1") c) (>= (ascii "9") c))
(setq str (strcat str (chr c)))
)
((= c (ascii "0"))
(if (and (= str "") komma)
(setq str (chr c))
)
(setq str (strcat str (chr c)))
)
((= c asck)
(if komma
(progn
(setq error T)
(setq done T)
)
(progn
(setq str (strcat str "."))
(setq komma T)
)
)
)
((= c asct)
(if (= "" str) (setq error T))
(setq done T)
)
((= c 10)
(if (= "" str) (setq error T))
(setq eol T)
(setq done T)
)
((not c)
(setq eof T)
(setq done T)
)
(T
(setq error T)
(setq done T)
)
)
)
(if (not error)
(if ganz (atoi str) (atof str))
)
)

(princ ".")
(princ " Initialisieren mit 'INIT', Starten mit 'TRANSFER' ")
'fertig

Ich hoffe ich habs richtig gemacht, wenn nicht gib mir bitte bescheid, vielleicht kann ich dir die Datei per email schicken?
Leibe Grüße
Kegler

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP