Code:
;**********************************************************************************************
;* Programm zum Einlesen aus Punkteliste *
;* Autor: Gerhard Arend *
;* Dateien: korliste1 *
;* Releasestand 17.08.99 Version 1.2 Verwendung : Vermessungsamt Stadt Kassel und KEB *
;**********************************************************************************************
;
(defun c:korliste1 (/ beginn ) (setvar "CMDECHO" 0)
(setq olderror *error* ) ;alte Fehlerbehandlungsroutine speichern
(setq *error* fehleraus) ;wenn Fehler UP fehler aufrufen
(textpage) ;Textbildschirm leeren und umschalten
(princ "\n ******************************************************************************")
(princ "\n * Das Programm liest Koordinaten aus einer Liste und setzt in die *")
(princ "\n * Zeichnung einen Punkt. *")
(princ "\n * Das Verbinden der Punkte mit einer Linie ist Programmgesteuert moeglich. *")
(princ "\n * *")
(princ "\n * Stellen Sie Bitte vor Programmablauf mit Autocad-Befehl _DDPTYPE im *")
(princ "\n * Menü [Format] [Punktstil] die gewünschte Punktdarstellung ein. *")
(princ "\n * *")
(princ "\n * Zu empfehlende Punkt-Einstellung Kreis, Punktgröße 0.5 Einheiten *")
(princ "\n * Größe in absoluten Werten *")
(princ "\n * *")
(princ "\n * Wenn Sie Symbole in die Zeichnung einfügen wollen, müssen Sie zuvor *")
(princ "\n * eine Symboldatei laden. Befehl Laden *")
(princ "\n ******************************************************************************")
(terpri)
(initget 1 "j n J N")
(setq beginn (strcase (getkword "\nProgramm starten j / n ")) )
(graphscr)
(if (= beginn "J") (UP_korliste2))
(UP_ende)
)
;********** Programm Starten und Dialogbox aufrufen **********
(defun UP_korliste2 ( / filename dateiname datei zeile punkt0 punkt1 zaehler
i p1 p2 pt1 punkt1 punkt2 ptx pty ykorvor zeilenlaenge
fehler alay
zeichlinie spxkor xe anzxkor xkorvor spykor ye anzykor textspa1 textspe1 textspa2 textspe2
textwert1 spaltet1 spaltenanzt1 textwert2 spaltet2 spaltenanzt2
spzkor ze anzzkor codekenn codea codee codeanzahl codewahl setzen dibox
punktwert_0 punktwert_1 punktwert_2 namesymblo skfaktor
)
(setq Dat (load_dialog "korliste1.DCL")) ;DCL-Datei laden
(if (not (new_dialog "korliste1" Dat)) (exit)) ;Dialogfenster am Bildschirm anzeigen
(mode_tile "sym_blo_wert" 1) ;Edit-Box Blockdatei ist deaktiviert
(mode_tile "suchen_blo_file" 1) ;Suchen-Button ist deaktiviert
(action_tile "element_nein" "(mode_tile \"sym_blo_wert\" 1)
(mode_tile \"suchen_blo_file\" 1)")
(action_tile "element_sym" "(mode_tile \"sym_blo_wert\" (- 1 (atoi $value)))
(mode_tile \"suchen_blo_file\" 1)")
(action_tile "element_block" "(mode_tile \"sym_blo_wert\" (- 1 (atoi $value)))
(mode_tile \"suchen_blo_file\" (- 1 (atoi $value)))")
(action_tile "codier" "(mode_tile \"codierung\" (atoi $value))")
(action_tile "dspeich" "(UP_datenspeich)" )
(action_tile "dladen" "(UP_datenladen)" )
(action_tile "suchen_ein_file" "(get_ein_file)" ) ;UP zum suchen der Datei aufrufen
(action_tile "suchen_blo_file" "(get_blo_file)" ) ;UP zum suchen Blockdatei aufrufen
(action_tile "accept" "(auswerten) (if (= fehler 0) (done_dialog))") ;wenn OK ,UP-auswerten,
(action_tile "cancel" "(done_dialog)")
(start_dialog)
(unload_dialog Dat)
(if (= fehler 0)
(progn
(setq alay (getvar "clayer")) ;aktiver Layer
(setq datei (open filename "r")) ;Datei oeffnen, um aus Datei zu lesen
(setq zaehler 0)
(setq zeile 1)
(while zeile
(setq zeile (read-line datei)) ;Zeile aus Datei lesen
(if (= zeile NIL)
(princ "\nProgrammende") ;Zeile NIL = Dateiende erreicht
(progn
(setq setzen 1)
(if (= (strlen zeile) 0) (setq setzen NIL) ) ;wenn Zeilenlänge Null keine Berücksichtigung
(if (= (substr zeile 1 2) "//")(setq setzen NIL) ) ;wenn zeile beginnt mit // keine Berücksichtigung
(if (and (= codewahl 0) (/= (substr zeile codea codeanzahl) codekenn)) (setq setzen NIL));wenn Codekenn nicht übereinstimmt kein Durchlauf
(if (/= setzen NIL)
(progn
(UP_point) ;Unterprogramm UP_point aufrufen
(princ "\n")
(princ zaehler)
(princ " Koordinate eingelesen ")
(princ pt1)
(if (and (= zeichlinie "J") (> zaehler 1))
(progn
(command "._-layer" "_make" "punktverbindungslinie" "_color" "4" "" "") ;Layer anlegen fuer Punktverbindungslinie
(command "._pline" punkt0 punkt1 "")
(setq punkt0 punkt1) ;wird nur benoetigt wenn Verbindung punkt0-punkt1 erzeugt
)
(setq punkt0 punkt1)
)
(if (= punktwert_1) (command "symbol" namesymblo punkt1 skfaktor 0 ) )
(if (= punktwert_2) (command "._insert" namesymblo punkt1 skfaktor skfaktor 0 ) )
)
)
)
)
)
(close datei)
(command "._-layer" "_set" alay "") ;alten Layer wieder setzen
(setq *error* olderror)
(if (= zaehler 0) (princ "\nkeine Punkte gefunden"))
(princ)
)
)
)
(defun auswerten (/); Unterprogramm, um nach verlassen der Dialogbox die Eingaben in Variable zu setzen
(setq fehler 0) ;Zaehler für Fehler setzen
(setq dateiname (get_tile "name_liste"))
(if (= (get_tile "linieja") "1") (setq zeichlinie "J") )
(if (= (get_tile "linienein") "1") (setq zeichlinie NIL) )
(if (= (get_tile "element_nein") "1") (setq punktwert 0) )
(if (= (get_tile "element_sym") "1") (setq punktwert 1) )
(if (= (get_tile "element_block") "1") (setq punktwert 2) )
(if (= punktwert_1) ;wenn Symbol auf Koordinate
(progn
(setq namesymblo (atoi (get_tile "sym_blo_name")))
(setq skfaktor (atof (get_tile "sk_faktor")))
)
)
(if (= punktwert_2) ;wenn Block auf Koordinate
(progn
(setq namesymblo (get_tile "sym_blo_name"))
(setq skfaktor (atof (get_tile "sk_faktor")))
)
)
(setq spxkor (atoi (get_tile "xsa")) ) ;x-Wert bearbeiten
(setq xe (atoi (get_tile "xse")) )
(setq anzxkor (+ (- xe spxkor) 1) )
(setq xkorvor (atoi (get_tile "xvorwert")) )
(setq spykor (atoi (get_tile "ysa")) ) ;y-Wert bearbeiten
(setq ye (atoi (get_tile "yse")) )
(setq anzykor (+ (- ye spykor) 1) )
(setq ykorvor (atoi (get_tile "yvorwert")) )
(setq spzkor (atoi (get_tile "zsa")) ) ;z-Wert bearbeiten
(setq ze (atoi (get_tile "zse")) )
(if (and (> spzkor 0) (> ze spzkor))
(setq anzzkor (+ (- ze spzkor) 1) ) ;wenn z-Wert eingegeben Anzahl berechnen
(setq anzzkor 0) ;wenn kein z-Wert, dann Anzahl=0
)
(setq codewahl (atoi (get_tile "codier")) ) ;ob Codekennung 0=aktiv oder 1=deaktiv ist
(setq codekenn (get_tile "codew")) ;Codekenn-Buchstaben
(setq codea (atoi (get_tile "codespa")) ) ;Spalte von Codekennwert anfang
(setq codee (atoi (get_tile "codespe")) ) ;Spalte von Codekennwert ende
(if (and (> codea 0) (>= codee codea))
(setq codeanzahl (+ (- codee codea) 1) ) ;wenn Codespalten eingegeben Anzahl berechnen
(setq codeanzahl 0) ;wenn keine Codespalten, dann Anzahl=0
)
(setq textspa1 (atoi (get_tile "t1sa")) ) ;Textwert1 bearbeiten
(setq textspe1 (atoi (get_tile "t1se")) )
(if (and (> textspa1 0) (> textspe1 textspa1))
(progn
(setq textwert1 "j")
(setq spaltet1 textspa1)
(setq spaltenazt1 (+ (- textspe1 textspa1) 1) )
)
(setq textwert1 "n")
)
(setq textspa2 (atoi (get_tile "t2sa")) ) ;Textwert2 bearbeiten
(setq textspe2 (atoi (get_tile "t2se")) )
(if (and (> textspa2 0) (> textspe2 textspa2))
(progn
(setq textwert2 "j")
(setq spaltet2 textspa2)
(setq spaltenazt2 (+ (- textspe2 textspa2) 1) )
)
(setq textwert2 "n")
)
(setq filename (findfile dateiname)) ;Abfrage ob Punkteliste vorhanden ist
(if (= filename NIL)
(progn
(alert "Dateiname nicht gefunden")
(setq fehler (+ fehler 1))
)
)
(if (or (<= anzxkor 0) (= spxkor 0) (= xe 0)) ;wenn x-Spalten fehlerhaft
(progn
(alert "Spalten X-Koordinaten fehlerhaft")
(setq fehler (+ fehler 1))
)
)
(if (or (<= anzykor 0) (= spykor 0) (= ye 0)) ;wenn y-Spalten fehlerhaft
(progn
(alert "Spalten Y-Koordinaten fehlerhaft")
(setq fehler (+ fehler 1))
)
)
(if (and (> spzkor 0) (< ze spzkor)) ;wenn z-Spalten fehlerhaft
(progn
(alert "Spalten Z-Koordinaten fehlerhaft")
(setq fehler (+ fehler 1))
)
)
(if (and (= spzkor 0) (> ze 1)) ;wenn z-Spalten fehlerhaft
(progn
(alert "Spalten Z-Koordinaten fehlerhaft")
(setq fehler (+ fehler 1))
)
)
(if (and (= codekenn "") (= codewahl 0)) ;wenn Codierkennziffer fehlt bei aktiver Einstellung
(progn
(alert "Codierkennbuchstabe fehlt")
(setq fehler (+ fehler 1))
)
)
(if (and (= codea 0) (= codewahl 0)) ;wenn Codierspalte anfang fehlt bei aktiver Einstellung
(progn
(alert "Codier Spaltenanfang fehlt")
(setq fehler (+ fehler 1))
)
)
(if (and (= codee 0) (= codewahl 0)) ;wenn Codierspalte ende fehlt bei aktiver Einstellung
(progn
(alert "Codier Spaltenende fehlt")
(setq fehler (+ fehler 1))
)
)
(if (and (> codea codee) (= codewahl 0)) ;wenn Codierspalte anfang fehlt bei aktiver Einstellung
(progn
(alert "Codier Spaltenanfang/ende fehlerhaft")
(setq fehler (+ fehler 1))
)
)
)
(defun UP_point ( /); Unterprogramm Koordinate auslesen, Punkt erzeugen und Punkt in Autocad setzen
(setq p1 (substr zeile spxkor anzxkor)) ;aus Textzeile x-wert auslesen
(setq p2 (substr zeile spykor anzykor)) ;aus Textzeile y-wert auslesen
(if (> anzzkor 0) (setq p3 (substr zeile spzkor anzzkor)) ) ;aus Textzeile z-wert auslesen
(if (> xkorvor 0) ;Vorwert x-Koordinate einbinden
(setq ptx (strcat (itoa xkorvor) p1 ))
(setq ptx p1)
)
(if (> ykorvor 0) ;Vorwert y-Koordinate einbinden
(setq pty (strcat (itoa ykorvor) p2 ))
(setq pty p2)
)
(if (= anzzkor 0) (setq pt1 (strcat ptx " " pty)) ) ;kein z-Wert von x und y-wert Koordinate erzeugt
(if (> anzzkor 0) (setq pt1 (strcat ptx " " pty " " p3)) ) ;dreidimensionaler Punkt
(setq punkt1 (read (strcat "(" pt1 ")" ))) ;aus String einen getpoint erzeugen
(command "._layer" "_make" "gelaendepunkte" "_color" "2" "" "") ;Layer anlegen fuer Gelaendepunkte
(command "._pont" punkt1 )
(if (= textwert1 "j") (setq text1 (substr zeile spaltet1 spaltenazt1)) ) ;Textwert1 auslesen
(if (= textwert2 "j") (setq text2 (substr zeile spaltet2 spaltenazt2)) ) ;Textwert2 auslesen
(if (and (= textwert1 "j") (= textwert2 "j")) (setq point_text (strcat text1 "/" text2)) )
(if (and (= textwert1 "n") (= textwert2 "n")) (setq point_text "") )
(if (and (= textwert1 "j") (= textwert2 "n")) (setq point_text text1) )
(if (and (= textwert2 "j") (= textwert1 "n")) (setq point_text text2) )
(command "._text" punkt1 1.0 0 point_text )
(setq zaehler (+ zaehler 1))
)
(defun UP_datenspeich ()
(setq filename1 (findfile "korliste1.dat")) ;Abfrage ob Datei vorhanden ist
(if (= filename1 NIL)
(progn
(alert "Datei Korliste1.dat nicht gefunden")
(exit)
)
)
(setq eingdatei (open filename1 "w")) ;Datei oeffnen, um in Datei zu schreiben
(if (/= (get_tile "name_liste") "") (write-line (get_tile "name_liste") eingdatei) (write-line "NIL" eingdatei) )
(write-line (get_tile "linieja") eingdatei)
(write-line (get_tile "linienein") eingdatei)
(write-line (get_tile "element_nein") eingdatei)
(write-line (get_tile "element_sym") eingdatei)
(write-line (get_tile "element_block") eingdatei)
(if (/= (get_tile "sym_blo_name") "") (write-line (get_tile "sym_blo_name") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "sk_faktor") "") (write-line (get_tile "sk_faktor") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "xsa") "") (write-line (get_tile "xsa") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "xse") "") (write-line (get_tile "xse") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "xvorwert") "") (write-line (get_tile "xvorwert") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "ysa") "") (write-line (get_tile "ysa") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "yse") "") (write-line (get_tile "yse") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "yvorwert") "") (write-line (get_tile "yvorwert") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "zsa") "") (write-line (get_tile "zsa") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "zse") "") (write-line (get_tile "zse") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "codew") "") (write-line (get_tile "codew") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "codespa") "") (write-line (get_tile "codespa") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "codespe") "") (write-line (get_tile "codespe") eingdatei) (write-line "NIL" eingdatei) )
(write-line (get_tile "codier") eingdatei)
(if (/= (get_tile "t1sa") "") (write-line (get_tile "t1sa") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "t1se") "") (write-line (get_tile "t1se") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "t2sa") "") (write-line (get_tile "t2sa") eingdatei) (write-line "NIL" eingdatei) )
(if (/= (get_tile "t2se") "") (write-line (get_tile "t2se") eingdatei) (write-line "NIL" eingdatei) )
(close eingdatei)
(princ "\nDaten gespeichert")
)
(defun UP_datenladen ()
(setq filename1 (findfile "korliste1.dat")) ;Abfrage ob Datei vorhanden ist
(if (= filename1 NIL)
(progn
(alert "Datei Korliste1.dat nicht gefunden")
(exit)
)
)
(setq eingdatei (open filename1 "r")) ;Datei oeffnen, um aus Datei zu lesen
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "name_liste" "") (set_tile "name_liste" zeile) )
(set_tile "linieja" (read-line eingdatei))
(set_tile "linienein" (read-line eingdatei))
(set_tile "element_nein" (read-line eingdatei))
(if (= (get_tile "element_nein") "1") (mode_tile "sym_blo_wert" 1) )
(set_tile "element_sym" (read-line eingdatei))
(if (= (get_tile "element_sym") "1") (mode_tile "sym_blo_wert" 0) )
(set_tile "element_block" (read-line eingdatei))
(if (= (get_tile "element_block") "1") (mode_tile "sym_blo_wert" 0) )
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "sym_blo_name" "") (set_tile "sym_blo_name" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "sk_faktor" "") (set_tile "sk_faktor" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "xsa" "") (set_tile "xsa" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "xse" "") (set_tile "xse" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "xvorwert" "") (set_tile "xvorwert" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "ysa" "") (set_tile "ysa" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "yse" "") (set_tile "yse" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "yvorwert" "") (set_tile "yvorwert" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "zsa" "") (set_tile "zsa" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "zse" "") (set_tile "zse" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "codew" "") (set_tile "codew" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "codespa" "") (set_tile "codespa" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "codespe" "") (set_tile "codespe" zeile))
(set_tile "codier" (read-line eingdatei))
(if (= (get_tile "codier") "1") (mode_tile "codierung" 1) )
(if (= (get_tile "codier") "0") (mode_tile "codierung" 0) )
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "t1sa" "") (set_tile "t1sa" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "t1se" "") (set_tile "t1se" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "t2sa" "") (set_tile "t2sa" zeile))
(setq zeile (read-line eingdatei))
(if (= zeile "NIL") (set_tile "t2se" "") (set_tile "t2se" zeile))
(close eingdatei)
)
(defun get_ein_file ( / tempdatei) ;Datei suchen über Dialogbox
(if (setq tempdatei (getfiled "Datei-einlesen" "" "" 8))
(set_tile "name_liste" tempdatei)
)
)
(defun get_blo_file ( / tempdatei) ;Block suchen über Dialogbox
(if (setq tempdatei (getfiled "Blockdatei-einlesen" "dwg" "" 8))
(set_tile "sym_blo_name" tempdatei)
)
)
(defun UP_ende ()
(setq *error* olderror)
(princ "\nProgrammende")
(princ)
)
(defun fehleraus (s);UP-Fehlerroutine
(princ (strcat "\nFehler: " s)) ;Fehlermeldung ausgeben
(setq *error* olderror) ;alte Fehlermeldung zurücksetzen
(princ)
)