(princ ".") ; Bibliothek ACAD ; Last Edit: 09. März 2001 ; Funktionen: ; -l2p: Konvertiert Bögen und Linien eines einzugebenden Layers in ; PolyLinien und (optional) setzt die Breite von schon vorhandenen ; PolyLinien auf den ebenfalls einzugebenden Wert ; -polyb: "Lightvariante" von "l2p", realisiert nur die Änderung der ; Breite der Polylinien ; -jp: verbindet alle Polylinien eines Layers (bei gemeinsamen End- ; punkten) ; -hmodall: setzt die Höhen aller Entities auf einen vom Nutzer ; einzugebenden Wert, optional ; -hmodins: "Lightvariante" von "hmodall", modifiziert nur die Höhen von ; INSERTS ; -cl: ermöglicht das "interaktive mausorientierte Layerwechseln" ; für vom Nutzer auszuwählende Entities ; -syml: ändert den ZEICHNUNGSLAYER eines vom Nutzer einzugebenden Blocks ; -fn: sucht String (PktNummer) auf allen/einem NUM-Layer, zeigt ihn ; zentriert ; -th: ändert die Texthöhe von Textobjekten, vom Nutzer einzugeben: ; a) Layer ; b) Zeichenkette ; c) neue Texthöhe ; d) ? exakter Vergleich ; -qa: "Kontrol-Q-A" fürs AutoCad, allerdings mit folgenden ; Einschränkungen: ; 1) der "alte" Text muss komplett eingegeben werden ; 2) Ersetzung ist immer kontextsensitiv ... ; Es gibt die Varianten: ; a) globales Ersetzen ; b) einzelne Abfrage ; -fqa siehe qa, alledings werden Layer, alter und neuer Text über ; eine Datei spezifiziert ; -ed Auflösen (Purgen) aller Bemassungen einer Zeichnung ; -roti Drehen: ; a) aller Texte ; b) ausgewählter Symbole ; innerhalb eines frei wählbaren Polygons im rechten Winkel ; zu einer vom Nutzer zu spezifizierenden Basislinie. Dabei ; wird ; c) eine Teilmenge der Symbole (make_int und CARD/1) ; nur in einem Bereich von +-45 Grad (0 iss oben) ausgerichtet ; (wegen Lesbarkeit von z.b. W) ; (setq verifyID 0) (setq testedID 0) ; (defun cleanIns (Liste SymContainer / n Next Laenge Data TmpListe TData Counter) ; (setq TmpList (ssadd)) (if (/= Liste nil) (progn (setq n 0 Next (ssname Liste n) Laenge (sslength Liste) ) (while (< n Laenge) (setq Data (entget Next)) (setq TData (cdr (assoc 2 Data))) (if (member (strcase TData) SymContainer) (progn (setq TmpList (ssadd Next TmpList) ) ) ) (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while ); progn ); if (setq Liste TmpList) ) ; (defun generate_poly ( / p1 p2 l1 l2 lnum x1 x2 tmp) (graphscr) (setq x1 (ssadd)) (setq tmp nil) (setq p1 (getpoint "\n\n ... erster Punkt des umschließenden Polygons : ")) (setq p1 (list (car p1) (cadr p1))) (setq MinX (car p1)) (setq MaxX (car p1)) (setq MinY (cadr p1)) (setq MaxY (cadr p1)) (setq lnum 0) (while (/= p1 nil) (setq p2 p1) (setq p1 (getpoint "\n ... nächster Punkt ... ")) (if (/= p1 nil) (progn (setq p1 (list (car p1) (cadr p1))) (setq MinX (min MinX (car p1))) (setq MaxX (max MaxX (car p1))) (setq MinY (min MinY (cadr p1))) (setq MaxY (max MaxY (cadr p1))) (setq lnum (1+ lnum)) (if (= lnum 1) (setq l1 (list p2 p1)) (progn (setq l2 (list p2 p1)) (if (= lnum 2) (setq tmp (list l2 l1)) (setq tmp (cons l2 tmp)) ) ) ) (command "linie" p2 p1 "") (setq x2 (entlast)) (setq x1 (ssadd (entlast) x1)) (command "ändern" x2 "" "eigenschaften" "farbe" "grün" "") ) ) ) (setq p1 (list tmp x1)) ) ; (defun fintersec ( La Lb / ) (inters (car La) (cadr La) (car Lb) (cadr Lb) ) ) ; ; (defun c:roti ( / Poly SymContainer TextListe InsertListe Direct PLines qfd AunitsVar AngDirVar AngBaseVar OsModeVar) ; ; "Konstanten" und "Variablen" (init_err) (setq AunitsVar (getvar "AUNITS")) (setvar "AUNITS" 3) (setq AngDirVar (getvar "ANGDIR")) (setvar "ANGDIR" 0) (setq AngBaseVar (getvar "ANGBASE")) (setvar "ANGBASE" (/ pi 2)) (setq OsModeVar (getvar "OSMODE")) (setvar "OSMODE" 0) (textpage) (princ "\nAusrichten von Texten und (bestimmten) Symbolen") (princ "\n-----------------------------------------------") ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 make_int- und CARD/1-Symbole ") (write-line " 2 Höhentexte und S-Höhentexte ") (write-line " 4 Punktnummern ") (write-line " 8 Flurstücksnummern ") (write-line "") (setq auswahl (getint "Ihre Eingabe <7> : ")) (if (= auswahl nil) (setq auswahl 7)) (write-line "") ; (setq Poly (generate_Poly)) (setq PLines (cadr Poly)) (setq Poly (car Poly)) ; (setq Direct (getorient "\n\nRichtung (2 Punkte/Zahl): ")) (if (= Direct nil) (setq Direct 0.0) ) (setq qfd (strcase (getstring "\nausgewählte Texte und Symbole ausrichten --> Start ? ")) ) (if (= qfd "") (setq qfd "J")) (if (= qdf "j") (setq qdf "J")) (if (/= qfd "J") (setq qfd "N")) ; (if (= qfd "J") (progn (setvar "OSMODE" 0) (if (boole 1 auswahl 1) ; definieren der Symbole, die gedreht werden sollen) ; (list "1" "2" "3" "4" "7A" "8" "9" "10" "10A" "10B" "10C" "10D" "10E" ; "10F" "10G" "10H" "11" "111" "112" "11A" "11B" "11C" "11D" "11E" ; "11F" "11G" "11H" "11I" "11J" "11K" "11L" "11M" "138" "183" "21" ; "303" "304" "310" "35" "36" "37" "381" "39" "40" "41" "411" "412" ; "42" "431" "433" "50" "501" "507" "51" "517" "52" "521" "527" "53" ; "537" "55" "552" "553" "57" "571" "60" "601" "64" "65" "651" "67" ; "701" "702" "703" "71" "76" "774" "775" "776" "79" "80" "801" "802" ; "82" "871" "872" "873" "874" "90" "91" "922" "923" "93" "94" "98" ; "980" "981" "982" "983" "984" "985" "986") ; ; (list "35" "37" "381" "58" "98") ; (setq SymContainer (list ; !!! make_int - Symbole !!! ; "8" (strcase "tpkt") ; TP ;"21" (strcase "fahrbm") ; FAHRBAHNMITTE ; "35" (strcase "rs") ; ROHRSOHLE ; "37" (strcase "ans") ; ; "381" (strcase "wscha2") ; ;"39" (strcase "dkm") ; DENKMAL ;"40" (strcase "br1") ; SPRINGBRUNNEN ;"41" (strcase "ws" ) ; WASSERSCHIEBER ;"411" (strcase "as" ) ; ABWASSERSCHIEBER ;"42" (strcase "hydr1") ; ÜBERFLURHYDRANT ;431" (strcase "schacht1") ; ABWASSERSCHACHT rund ;433" (strcase "schacht3") ; EINLAUFSCHACHT rund ;435" (strcase "dscha") ; DRAINAGESCHACHT ;"50" (strcase "mast1") ; STAHLGITTERMAST ;"52" (strcase "mast3") ; BETONMAST ;"53" (strcase "mast4") ; HOLZMAST ;"57" (strcase "lat") ; LATERNE ;"58" (strcase "rufs") ; RUFSÄULE ;"64" (strcase "gass") ; GASSÄULE / MERKSTEIN ;"67" (strcase "gwt") ; GASWASSERTOPF ;"76" (strcase "oel") ; OELABSCHEIDER ;"80" (strcase "br2") ; BRUNNEN ;"89" (strcase "klgr") ; KLÄRGRUBE RUND ;"90" (strcase "wass") ; WASSERSÄULE ;"901" (strcase "enf") ; ENTLÜFTUNG ;"91" (strcase "gs") ; GASSCHIEBER ;922" (strcase "bohr2") ; BOHRPUNKT ;923" (strcase "bohr3") ; PEGELBOHRPUNKT ;"93" (strcase "ok") ; OBERKANTE ;"94" (strcase "uk") ; UNTERKANTE ;"95" (strcase "fallr") ; FALLROHR ;"H*" (strcase "hkrz") ; HÖHENKREUZ ;"98" (strcase "pkt") ; Der ganze Rest .... ; !!! CARD/1 - Symbole !!! ; "1" (strcase "symb1321") ; Schacht Heizungsanlage ; "2" (strcase "symb0001") ; Punkt Böschung oben ; "3" (strcase "symb0001") ; Punkt Böschung unten ; "4" (strcase "symb0001") ; Punkt Graben ; "7A" (strcase "symb0005") ; Grenzpunkt übernommen Verm.Büro ; "8" (strcase "symb0005") ; TP ; "9" (strcase "symb1313") ; Fernmeldeschacht ; "10" (strcase "symb1124") ; Nadelbaum ; "10A" (strcase "symb1150") ; Eibe ; "10B" (strcase "symb1151") ; Fichte ; "10C" (strcase "symb1152") ; Kiefer ; "10D" (strcase "symb1153") ; Lärche ; "10E" (strcase "symb1154") ; Lebensbaum ; "10F" (strcase "symb1155") ; Tanne ; "10G" (strcase "symb1156") ; Wacholder ; "10H" (strcase "symb1157") ; Zypresse ; "11" (strcase "symb1122") ; Laubbaum ; "111" (strcase "symb1123") ; Obstbaum ; "112" (strcase "symb1304") ; Obstplantage ; "11A" (strcase "symb1140") ; Ahorn ; "11B" (strcase "symb1141") ; Birke ; "11C" (strcase "symb1142") ; Buche ; "11D" (strcase "symb1143") ; Eiche ; "11E" (strcase "symb1144") ; Esche ; "11F" (strcase "symb1145") ; Kastanie ; "11G" (strcase "symb1146") ; Linde ; "11H" (strcase "symb1147") ; Pappel ; "11I" (strcase "symb1148") ; Weide ; "11J" (strcase "symb1148") ; Eberesche ; "11K" (strcase "symb1148") ; Erle ; "11L" (strcase "symb1148") ; Robinie ; "11M" (strcase "symb1326") ; Laubbaum planerischer Bedeutung ; "138" (strcase "symb1312") ; Tankstelle ; "183" (strcase "symb0001") ; OK Eingangsstufe ; "21" (strcase "symb0001") ; Fahrbahnmitte ; "303" (strcase "symb0636") ; Bus- und Bahnhaltestelle ; "304" (strcase "symb1300") ; Werbetafel ; "310" (strcase "symb1324") ; Windrad ; "36" (strcase "symb1314") ; Fahnenmast ; "39" (strcase "symb1248") ; Denkmal ; "41" (strcase "symb1119") ; Wasserschieber ; "42" (strcase "symb1247") ; Überflurhydrant ; "431" (strcase "symb1327") ; Abwasserschacht rund ; "433" (strcase "symb1093") ; Einlaufschacht rund ; "50" (strcase "symb1237") ; Stahlgittermast ; "501" (strcase "symb1323") ; Funkmast ; "507" (strcase "symb1070") ; Stahlgittermast mit Leuchte ; "51" (strcase "symb1083") ; Stahlrohrmast ; "517" (strcase "symb1070") ; Stahlrohrmast mit Leuchte ; "52" (strcase "symb1080") ; Betonmast ; "521" (strcase "symb1100") ; Doppelmast ; "527" (strcase "symb1070") ; Betonmast mit Leuchte ; "53" (strcase "symb1077") ; Holzmast ; "537" (strcase "symb1070") ; Holzmast mit Leuchte ; "55" (strcase "symb0556") ; Merkzeichen Elt ; "552" (strcase "symb0558") ; Merkzeichen Post ; "553" (strcase "symb0559") ; Merkzeichen Fernwärme ; "57" (strcase "symb1070") ; Laterne ; "571" (strcase "symb1270") ; Gaslaterne ; "60" (strcase "symb0011") ; Leitungspunkt Freiltg. Strom ; "601" (strcase "symb0011") ; Leitungspunkt Freiltg. Tel. ; "64" (strcase "symb0557") ; Merkzeichen Gas ; "65" (strcase "symb1309") ; Symbol Parkplatz ; "651" (strcase "symb1319") ; Parkuhr ; "701" (strcase "symb0001") ; Grenzpkt. nicht abgem. ; "702" (strcase "symb1077") ; Grenzpkt. Übernommen ; "703" (strcase "symb0569") ; Grenzpkt. nicht aktuell ; "71" (strcase "symb0001") ; Sohle ; "774" (strcase "symb0001") ; Pfeiler Achse ; "775" (strcase "symb0001") ; Pfeiler Ecke ; "776" (strcase "symb1328") ; Lichte Höhe ; "79" (strcase "symb1311") ; Telefonzelle ; "80" (strcase "symb0553") ; Brunnen ; "801" (strcase "symb0552") ; Quelle ; "802" (strcase "symb0554") ; Pumpe ; "82" (strcase "symb1415") ; Wasserspiegel ; "871" (strcase "symb1005") ; Laubwald ; "872" (strcase "symb1010") ; Nadelwald ; "873" (strcase "symb1011") ; Mischwald ; "874" (strcase "symb1256") ; Gebüsch ; "90" (strcase "symb0568") ; Merkzeichen Wasser ; "91" (strcase "symb1117") ; Gasschieber ; "98" (strcase "symb0001") ; Sonstiges ; "980" (strcase "symb1305") ; Acker ; "981" (strcase "symb1036") ; Wiese ; "982" (strcase "symb1015") ; Moor ; "983" (strcase "symb1016") ; Schilf ; "984" (strcase "symb1012") ; Parkanlage ; "985" (strcase "symb1306") ; Gartenanlage ; "986" (strcase "symb1435") ; Campingplatz ; "99" (strcase "symb0002") ; PP ; "991" (strcase "symb0002") ; AP ; "Nadelbaum" (strcase "symb1325") ; Nadelbaum ; "Laubbaum" (strcase "symb1001") ; Laubbaum ; "Obstbaum" (strcase "symb1280") ; Obstbaum ) ) ) ; TextListe generieren ... (princ "\nEinsammeln der Texte ..") (setq TextListe nil) (if (boole 1 auswahl 2) (progn (setq InsertListe (ssget "x" '((0 . "TEXT") (8 . "H*")) ) ) (setq TextListe (MergeList TextListe InsertListe T)) (setq InsertListe (ssget "x" '((0 . "TEXT") (8 . "SH*")) ) ) (setq TextListe (MergeList TextListe InsertListe T)) ) ) (if (boole 1 auswahl 4) (progn (setq InsertListe (ssget "x" '((0 . "TEXT") (8 . "*NUM")) ) ) (setq TextListe (MergeList TextListe InsertListe T)) (setq InsertListe (ssget "x" '((0 . "TEXT") (8 . "8")) ) ) (setq TextListe (MergeList TextListe InsertListe T)) (setq InsertListe (ssget "x" '((0 . "TEXT") (8 . "99")) ) ) (setq TextListe (MergeList TextListe InsertListe T)) (setq InsertListe (ssget "x" '((0 . "TEXT") (8 . "991")) ) ) (setq TextListe (MergeList TextListe InsertListe T)) ) ) (if (boole 1 auswahl 8) (progn (setq InsertListe (ssget "x" '((0 . "TEXT") (8 . "FLUR")) ) ) (setq TextListe (MergeList TextListe InsertListe T)) ) ) (setq Insertliste nil) (if (boole 1 auswahl 1) (progn ; und Insertliste dazu (princ ". der Inserts ..") (setq InsertListe (ssget "x" '((0 . "INSERT")) ) ) ; (princ ". Aufräumen der Liste .") (setq InsertListe (cleanIns InsertListe SymContainer)) (princ ".") ) ) (setq InsertListe (MergeList TextListe InsertListe T)) (princ ". und Ausrichten der Objekte ...") (setq InsertListe (insidePoly InsertListe Poly)) (command "löschen" PLines "") (setvar "AUNITS" AunitsVar) (setvar "ANGDIR" AngDirVar) (setvar "ANGBASE" AngBaseVar) (setvar "OSMODE" OsModeVar) ) ; progn ) ; if (reset_err) (princ ) ) ; ; (defun checkPIP (Point Poly / X Y SPkte HLine abc cnt versuche zaehler p2x p2y egal listenlaenge) (setq X (car Point) Y (cadr Point) ) (if (or (< X MinX) (< Y MinY) (> X MaxX) (> Y MaxY) ) (setq X nil) ; else (expliziter Test) (progn (setq cnt 5) (setq versuche 0) (setq p2y (car Point)) (setq p2x MaxY) (while (/= cnt 0) (setq cnt 0) (setq versuche (1+ versuche)) (setq p2y (+ p2y 1.234)) (setq p2x (+ p2x 2.345)) (setq HLine (list Point (list p2y p2x))) (setq listenlaenge (length Poly)) (setq zaehler 0) (while (< zaehler listenlaenge) (setq abc (inters (car HLine) (cadr HLine) (car (nth zaehler Poly)) (cadr (nth zaehler Poly)))) (if (or (= abc (car (nth zaehler Poly))) (= abc (cadr (nth zaehler Poly))) ) (setq cnt (1+ cnt)) ) (setq zaehler (1+ zaehler)) ) ) (setq SPkte 0) (setq listenlaenge (length Poly)) (setq zaehler 0) (setq egal 0) (while (< zaehler listenlaenge) (setq abc (inters (car HLine) (cadr HLine) (car (nth zaehler Poly)) (cadr (nth zaehler Poly)))) (if (/= abc nil) (progn (if (< (distance abc (car HLine)) 0.0001) ; (if (= abc (car HLine)) (progn (setq egal 1) (setq zaehler listenlaenge) ) (progn (setq SPkte (1+ SPkte)) (setq zaehler (1+ zaehler)) ) ) ) (setq zaehler (1+ zaehler)) ) ) (if (= egal 1) (setq cnt 1) (setq cnt (rem SPkte 2)) ) (if (= cnt 0) (setq X nil) ; else (setq X T) ) ); progn ) ) ; (defun insidePoly (Liste Poly / n BName Winkel Next TmpDir Laenge Data TData Counter) (setq TmpList (ssadd)) (if (/= Liste nil) (progn (setq n 0 Next (ssname Liste n) Laenge (sslength Liste) Extra (list "RS" "ANS" "WSCHA2" "RUFS" "PKT") Counter 0 ) (while (< n Laenge) (setq Data (entget Next)) (setq TData (cdr (assoc 10 Data))) (setq Winkel (cdr (assoc 50 Data ))) (if (checkPIP TData Poly) (progn (setq BName (cdr (assoc 2 Data)) TmpDir Direct ) (if (member BName Extra) (progn (while (> Direct (/ pi 4)) (setq Direct (- Direct (/ pi 2))) ) (if (< Direct 0) (setq Direct (+ Direct (* pi 2))) ) ;(princ "\n Extrawurst ;-)") ) ) (command "drehen" Next "" TData "B" Winkel Direct) (setq Counter (1+ Counter)) (setq Direct TmpDir ) ) ) (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while ); progn ); if (princ "\nAnzahl der ausgerichteten Objekte : ") (princ Counter) ) (defun c:ed ( / qfd ) (init_err) ;(initLisp_extern) (textpage) (princ "\nAuflösen aller Bemaßungen der aktuellen Zeichnung") (princ "\n---------------------------------------------------\n\n\n") (setq qfd (strcase (getstring " --> Start ? "))) (if (= qfd "") (setq qfd "J")) (if (= qfd "j") (setq qfd "J")) (if (/= qfd "J") (setq qfd "N")) (if (= qfd "J") (progn (expldim) ); progn ); if (reset_err) (princ ) ) (defun c:fqa ( / Zeile Layer ZK NewZK FName) (init_err) ;(initLisp_extern) (textpage) (princ "\nErsetzen von Texten auf einem Layer (Dateivariante)") (princ "\n----------------------------------------------------\n") (princ "\n Die für dieses Progamm notwendige Eingabedatei muß folgendes ") (princ "\n Format aufweisen : ") (princ "\n\n LAYER") (princ "\n Alter_Text") (princ "\n Neuer_Text") (setq FName (getstring T "\n\n\n Dateiname : ")) (if (= FName "") (setq FName "qa.dat") ) (setq qfd (open FName "r")) (if (= qfd nil) (progn (princ "\n Fehler : Datei ") (princ FName) (princ " kann nicht gelesen werden !") (exit) ) ) (setq Liste (list (read-line qfd) (read-line qfd) (read-line qfd) )) (close qfd) (setq Liste (subst "" nil Liste)) (setq Layer (strcase (car Liste)) ZK (cadr Liste) NewZK (caddr Liste) ) (princ "\n\n Folgende Ersetzung wird vorgenommen ... ") (princ "\n\n Auf Layer : ") (princ Layer) (princ "\n werden alle Texte : ") (princ ZK) (princ "\n durch : ") (princ NewZK) (princ "\n\n ersetzt.") (setq qfd (strcase (getstring " --> Start ? "))) (if (= qfd "") (setq qfd "J")) (if (= qfd "j") (setq qfd "J")) (if (/= qfd "J") (setq qfd "N")) (if (= qfd "J") (progn (LayerCheck Layer) (run_QA ZK NewZk Layer) ); progn ); if (reset_err) (princ ) ) (defun c:qa ( / Layer ZK NewZK ) (init_err) ;(initLisp_extern) (textpage) (princ "\nErsetzen von Texten auf einem Layer") (princ "\n----------------------------------------------------\n") (setq Layer (strcase (getstring "\n\n Layer : "))) (if (= Layer nil) (exit)) (LayerCheck Layer) (setq ZK (getstring T "\n Finde Text ... : ")) (if (= ZK "") (progn (princ "Dann eben nicht ... ") (exit) ) ) (setq NewZK (getstring T " und ersetze mit : ")) (if (= NewZK "") (progn (princ "Dann eben nicht ... ") (exit) ) ) (run_QA ZK NewZk Layer) (reset_err) (princ ) ) (defun run_QA (ZK NewZK Layer / Exakt Liste n Next Counter Laenge Data AskEach NLay CurLayer) (setq Exakt (strcase (getstring "\n Exakter Vergleich ? "))) (if (= Exakt "") (setq Exakt "J")) (if (= Exakt "j") (setq Exakt "J")) (if (/= Exakt "J") (setq Exakt "N")) (setq CurLayer (getvar "CLAYER")) (command "-layer" "t" Layer "") (command "-layer" "se" Layer "") ; erstmal alles einsammeln .... (setq Dest (ssadd)) (setq Liste (ssget "x" '((0 . "TEXT")))) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (setq Counter 0) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) (setq NLay (cdr (assoc 8 Data))) (if (= NLay Layer) (progn (setq NText (cdr (assoc 1 Data))) (if (= NText ZK) (progn (setq Counter (1+ Counter)) (setq Dest (ssadd Next Dest)) ); progn ; else (if (/= Exakt "J") (progn (if (wcmatch (strcat "X" NText) (strcat "X*" ZK "*" ) ) (progn (setq Counter (1+ Counter)) (setq Dest (ssadd Next Dest)) ) ); if matching ) ; progn ) ; if exakt ); = NText ZK ); progn ); if (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while (princ "\n\n gefundene Texte : ") (princ Counter) ); progn ); if (if (< 1 Counter) (progn (setq AskEach (strcase (getstring "\n\n Jedes Ersetzten einzeln bestätigen "))) (if (= AskEach "") (setq AskEach "N")) (if (/= Dest nil) (progn (setq n 0) (setq Next (ssname Dest n)) (setq Laenge (sslength Dest)) (setq Counter 0) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) (setq NText (cdr (assoc 1 Data))) (if (= AskEach "N") (progn (setq Counter (1+ Counter)) (command "ändern" Next "" "" "" "" "" "" NewZk) ); progn ; else (progn ; Berechnung der ZoomKoordinaten (setq NLay (cdr (assoc 10 Data))) (setq ZK (cdr (assoc 40 Data))) (setq Layer (car NLay)) (setq NLay (cadr NLay)) (setq Layer (list Layer NLay)) (cond ((= ZK nil) (setq ZK 50)) ((= ZK 0) (setq ZK 50)) (T (setq ZK (* 50 ZK))) ) (command "zoom" "m" Layer ZK ) (command "zurück" "B") (command "eigändr" Next "" "f" 230 "") (command "zurück" "e") (setq ZK (strcase (getstring "\n Text ändern ? "))) (if (= ZK "") (setq ZK "J")) (if (= ZK "j") (setq ZK "J")) (command "zurück" 1) (if (= ZK "J") (progn (setq Counter (1+ Counter)) (command "ändern" Next "" "" "" "" "" "" NewZk) ) ) ) ; progn ); if AskEach == "N" (setq n (1+ n)) (setq Next (ssname Dest n)) ) ; while (princ "\n Anzahl der geänderten Texte : ") (princ Counter) ); progn ); if ); progn ); if Counter (command "-layer" "se" CurLayer "") (command "regen") ) (defun c:fn ( / Dest Liste Nummer Data Next n Laenge NLay) (init_err) ;(initLisp_extern) (textpage) (princ "\nFinden einer Punktnummer") (princ "\n--------------------------------------------------\n") (princ "\n Gebäude 1 ") (princ "\n Straßen 2 ") (princ "\n Einzelpunkte 3 ") (princ "\n Grenzen 4 ") (princ "\n Sonstige 5 ") (princ "\n ALLE 0 ") (setq Dest (getint "\n\n Suchen in <0> : ")) (if (= Dest nil) (setq Dest 0)) (if (< Dest 0) (setq Dest 0)) (if (> Dest 5) (setq Dest 0)) (setq Nummer (strcase (getstring "\n\n Punktnummer : "))) (cond ( (= Dest 1) (setq Liste (ssget "x" '((0 . "TEXT") (8 . "GEBNUM")) )) ) ( (= Dest 2) (setq Liste (ssget "x" '((0 . "TEXT") (8 . "STRANUM")) )) ) ( (= Dest 3) (setq Liste (ssget "x" '((0 . "TEXT") (8 . "EINZELNUM")) )) ) ( (= Dest 4) (setq Liste (ssget "x" '((0 . "TEXT") (8 . "SONSTNUM")) )) ) ( (= Dest 5) (setq Liste (ssget "x" '((0 . "TEXT") (8 . "GRENZNUM")) )) ) ( (= Dest 0) (setq Liste (ssget "x" '((0 . "TEXT") (8 . "*NUM")) )) ) ) (setq Dest (ssadd)) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (setq Counter 0) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) ; Layernamen der Linie herausfischen .... (setq NLay (cdr (assoc 1 Data))) (if (= NLay Nummer) (progn (setq Dest (ssadd Next Dest)) (setq Counter (1+ Counter)) ) ;progn ); if (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while (princ "\n --> Gefundene Punknummern : ") (princ Counter) (princ "\n") ); progn (progn (princ "\nKeine Punktnummern gefunden \n") ); else progn ); if (setq Liste Dest) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (setq Counter 0) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) (setq NLay (cdr (assoc 10 Data))) (setq Nummer (cdr (assoc 40 Data))) (setq Dest (car NLay)) (setq NLay (cadr NLay)) (setq Dest (list Dest NLay)) (cond ((= Nummer nil) (setq Nummer 50)) ((= Nummer 0) (setq Nummer 50)) (T (setq Nummer (* 50 Nummer))) ) (setq NLay (cdr (assoc 8 Data))) (setq Data NLAy) (setq NLay (LayerCheck NLay)) (setq NLay (cdr (assoc 70 NLay))) (if (= Nlay 65) (progn (command "-layer" "t" Data "") (princ " --> Hinweis: Layer ") (princ Data) (princ " wurde getaut ...") ) ) (command "zoom" "m" Dest Nummer ) (command "zurück" "b") (command "eigändr" Next "" "f" 230 "") (command "zurück" "e") (setq n (1+ n)) (setq Next (ssname Liste n)) (if (/= n Laenge) (progn (setq Nummer (strcase (getstring "\n Nächsten Punkt zeigen ? "))) (if (= Nummer "") (setq Nummer "J")) (if (= Nummer "j") (setq Nummer "J")) (if (/= Nummer "J") (setq n (1+ Laenge))) ); progn (progn (getstring "\n für Ende ...") ); else progn ); if (command "zurück" 1) ) ; while ); progn ); if ; ; (reset_err) (princ ) ) ; ; ; (defun c:th ( / Liste n Next Counter Laenge Data Exakt NLay OldPolys Layer ZK TxtH) (init_err) ;(initLisp_extern) (textpage) (princ "\nÄndern der Texthöhen bestimmter Texte eines Layers") (princ "\n----------------------------------------------------\n") (setq Layer (strcase (getstring "\n\n Layer : "))) (if (= Layer nil) (exit)) (LayerCheck Layer) (setq ZK (getstring T " Text : ")) (if (= ZK "") (progn (princ "Dann eben nicht ... ") (exit) ) ) (setq TxtH (getreal " Texthöhe <1.0> : ")) (if (= TxtH nil) (setq TxtH 1.0)) (setq Exakt (strcase (getstring "\n Exakter Vergleich ? "))) (if (= Exakt "") (setq Exakt "J")) (if (= Exakt "j") (setq Exakt "J")) (if (/= Exakt "J") (setq Exakt "N")) (setq Liste (ssget "x" '((0 . "TEXT")))) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (setq Counter 0) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) (setq NLay (cdr (assoc 8 Data))) (if (= NLay Layer) (progn (setq NText (cdr (assoc 1 Data))) (if (= NText ZK) (progn (setq Counter (1+ Counter)) (command "ändern" Next "" "" "" "" TxtH "" "") ); progn ); if identisch ;else (if (/= Exakt "J") (progn (if (wcmatch (strcat "X" NText) (strcat "X*" ZK "*" ) ) (progn (setq Counter (1+ Counter)) (command "ändern" Next "" "" "" "" TxtH "" "") ) ); if matching ) ; progn ) ; if exakt ) ) (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while (princ "Anzahl der geänderten Texte : ") (princ Counter) ); progn ); if (reset_err) (princ ) ) (defun c:l2p ( / OldPolys Layer PolyThick CurLayer) (init_err) ;(initLisp_extern) (textpage) (princ "\nUmwandlung aller Linien eines Layers in Polylinien") (princ "\n--------------------------------------------------\n") (setq Layer (strcase (getstring "\n\n Layer : "))) (if (= Layer nil) (exit)) (LayerCheck Layer) (setq PolyThick (getreal " Linienstärke <0.0>: ")) (if (= PolyThick nil) (setq PolyThick 0.0)) (princ "\n Alle schon auf dem Layer ") (princ Layer) (princ " vorhandenen PolyLinien auch auf die neue ") (setq OldPolys (getstring "\n Linienstärke setzen : ")) (if (= OldPolys "") (setq OldPolys "N")) (setq CurLayer (getvar "CLAYER")) (command "-layer" "t" Layer "") (command "-layer" "se" Layer "") (if (/= OldPolys "n") (cnvPoly Layer PolyThick) ) (changeArcs Layer PolyThick) (changeLines Layer PolyThick) (command "-layer" "se" CurLayer "") (command "regen") (reset_err) (princ ) ) (defun c:polyb ( / Layer PolyThick CurLayer) (init_err) ;(initLisp_extern) (textpage) (princ "\nSetzen der Breite aller Polylinien eines Layers ") (princ "\n---------------------------------------------\n") (setq Layer (strcase (getstring "\n\n Layer : "))) (if (= Layer nil) (exit)) (LayerCheck Layer) (setq PolyThick (getreal " Linienstärke <0.0> : ")) (if (= PolyThick nil) (setq PolyThick 0.0)) (setq CurLayer (getvar "CLAYER")) (command "-layer" "t" Layer "") (command "-layer" "se" Layer "") (cnvPoly Layer PolyThick) (command "-layer" "se" CurLayer "") (command "regen") (reset_err) (princ ) ) (defun selectOpen ( Liste Layer / Data Ent Len Open) (setq n 0) (setq Len (sslength Liste)) (setq Open (ssadd)) (while (< n Len) (setq Ent (ssname Liste n)) (setq Data (entget Ent)) (if Ent (progn (if (/= 1 (cdr (assoc 70 Data))) (progn (setq NLay (cdr (assoc 8 Data))) (if (= NLay Layer) (progn (ssadd Ent Open) ) ;progn ); if ) );if ); progn ) ; if (setq n (1+ n)) ) (setq Data Open) ) (defun c:jP ( / Liste L1 L2 n Next Laenge P1 Counter NLay) (init_err) ;(initLisp_extern) (textpage) (princ "\nVerbinden aller Polylinien eines Layers ") (princ "\n---------------------------------------------\n") (setq Layer (strcase (getstring "\n\n Layer : "))) (if (= Layer nil) (exit)) (LayerCheck Layer) (setq L1 (ssget "x" '((0 . "POLYLINE")) )) (setq L2 (ssget "x" '((0 . "LWPOLYLINE")) )) (setq Liste (MergeList L1 L2 T)) (setq Liste (selectOpen Liste Layer)) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (setq Counter 0) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) (if (/= Data nil) (progn ; Layernamen der Linie herausfischen .... (setq NLay (cdr (assoc 8 Data))) (if (= NLay Layer) (progn (command "pedit" Next "v" Liste "" "") (setq Counter (1+ Counter)) ) ;progn ); if ) ; progn ) ; if (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while (princ "Anzahl der geänderten PolyLinien : ") (princ Counter) ); progn (progn (princ "\nKeine PolyLinien gefunden ....\n") ); else progn ); if (reset_err) (princ) ) (defun cnvPoly ( Layer PolyThick / L1 L2 Liste n Next Laenge P1 Counter NLay) (setq L1 (ssget "x" '((0 . "POLYLINE")) )) (setq L2 (ssget "x" '((0 . "LWPOLYLINE")) )) (setq Liste (MergeList L1 L2 T)) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (setq Counter 0) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) ; Layernamen der Linie herausfischen .... (setq NLay (cdr (assoc 8 Data))) (if (= NLay Layer) (progn (command "pedit" Next "b" PolyThick "") (setq Counter (1+ Counter)) ) ;progn ); if (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while (princ "Anzahl der geänderten PolyLinien : ") (princ Counter) ); progn (progn (princ "\nKeine PolyLinien gefunden ....\n") ); else progn ); if ) (defun MergeList (List1 List2 E-Flag / n Next Laenge ) (if (/= E-Flag nil) (progn (if (= List2 nil) (setq List2 List1) ; else (progn (if (/= List1 nil) (progn (setq n 0 Next (ssname List1 n) Laenge (sslength List1) ) (while (< n Laenge) (setq List2 (ssadd Next List2)) (setq n (1+ n)) (setq Next (ssname List1 n)) ) ; while ); progn ); if (setq List1 List2) ); progn );if ); progn ; else (foreach item List1 (setq List2 (cons item List2))) ) ) (defun PolTrans (Winkel / ) (+ (/ pi 2 ) (- (* 2 pi) Winkel)) ) (defun GenKoords (Mitte Radius R1 / ) (list (+ (car Mitte) (* (sin (PolTrans R1)) Radius)) (+ (cadr Mitte) (* (cos (PolTrans R1)) Radius)) ) ) (defun changeArcs (Layer PolyThick / NLay Liste Laenge n Next Data DListe) (setq Liste (ssget "x" '((0 . "ARC")) )) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) ; Layernamen der Linie herausfischen .... (setq NLay (cdr (assoc 8 Data))) (if (= NLay Layer) (progn (setq DListe (cons Next DListe)) (setq Mitte (list (cadr (assoc 10 Data)) (caddr (assoc 10 Data)))) (setq P1 (GenKoords Mitte (cdr (assoc 40 Data)) (cdr (assoc 50 Data)))) (setq P2 (GenKoords Mitte (cdr (assoc 40 Data)) (cdr (assoc 51 Data)))) (command "plinie" P1 "k" "m" Mitte P2 ""); (setq P1 (entlast)) (command "pedit" P1 "b" PolyThick "") (restoreProps P1 Data) ) ;progn ); if (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while (FEntDel DListe) (princ "\n") (princ (FLen DListe) ) (princ " Bögen in Polylinien umgewandelt\n") ); progn (progn (princ "\nKeine Bögen gefunden ....\n") ); else progn ); if ) (defun getColor (Data / Tmp Res) (setq Tmp (assoc 62 Data)) (if (/= Tmp nil) (progn (setq Res (cdr Tmp)) ) (setq Res Tmp) ) ) (defun getLT (Data / Tmp Res) (setq Tmp (assoc 6 Data)) (if (/= Tmp nil) (progn (setq Res (cdr Tmp)) ) (setq Res Tmp) ) ) (defun restoreProps (Ent Data / Tmp) (setq Tmp (getColor Data)) (if (/= Tmp nil) (progn (command "ändern" Ent "" "ei" "f" Tmp "") );progn );if (setq Tmp (getLT Data)) (if (/= Tmp nil) (progn (command "ändern" Ent "" "e" "lt" Tmp "") );progn );if ) (defun changeLines (Layer PolyThick / NLay Liste Laenge n Next Data x1 x2 DListe) (setq Liste (ssget "x" '((0 . "LINE")) )) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (setq DListe ()) (while (< n Laenge) ; Entitydaten holen ... (setq Data (entget Next)) ; Layernamen der Linie herausfischen .... (setq NLay (cdr (assoc 8 Data))) (if (= NLay Layer) (progn (setq DListe (cons Next DListe)) (setq x1 (assoc 10 Data)) (setq x1 (list (cadr x1) (caddr x1))) (setq x2 (assoc 11 Data)) (setq x2 (list (cadr x2) (caddr x2))) (command "plinie" x1 x2 "") (setq x1 (entlast)) (command "pedit" x1 "b" PolyThick "") (restoreProps x1 Data) ) ) (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while (FEntDel DListe) (princ (FLen DListe) ) (princ " Linien in Polylinien umgewandelt\n") ); progn (progn (princ "\nKeine Linien gefunden ....\n") ); else progn ); if ) (defun LayerCheck (Layer / Next Tmp) (setq Next (tblsearch "LAYER" Layer)) (if (not Next) (progn (princ "\nLayer ist nicht definiert .. Programmende\n") (quit "User") ) ;else (progn (setq Tmp Next) ) ) ) (defun c:syml ( / MBlock MLayer ) (init_err) ;(initLisp_extern) (textpage) (princ "\nÄnderung des Layers aller _Zeichnungselemente_ eines Blocks") (princ "\n------------------------------------------------------------\n") (setq MBlock (getstring "\n\n Block : ")) (if (= MBlock nil) (exit)) (setq MLayer (strcase (getstring " ZielLayer : "))) (if (= MLayer nil) (exit)) (LayerCheck MLayer) (princ "\n") (changeLBlock MBlock MLayer) (command "regen") (reset_err) (princ ) ) (defun ChangeListe (EListe Item / Laenge n Ent) (setq Laenge (length EListe)) (setq n 0) (while (< n Laenge) (setq Ent (nth n EListe)) (ent_modL Ent Item) (setq n (1+ n)) ) ) (defun changeLBlock ( Block Layer / TmpE Item Next EListe Entity INext IData) ; Blockentityliste initiailisieren (setq EListe ()) ; ersten Block auf dubiose Weise holen ... ; .. und weiter, solange noch Bloecke da sein (setq Next (tblsearch "BLOCK" Block)) (if (not Next) (progn (print "Block ist nicht definiert") (exit) ) ) (setq Entity (cdr (assoc -2 Next))) (if Entity (progn ; in Liste einfuegen ... (setq EListe (cons Entity EListe)) (setq INext (entnext Entity)) (while INext (setq IData (entget INext)) (if IData (progn (setq EListe (cons INext EListe)) (setq TmpE (entnext INext)) (if (= TmpE INext) (setq INext nil) (setq INext TmpE) ) ) ) ) ) ) (setq Item (AssocItem Layer)) (ChangeListe EListe Item) ) (defun AssocItem (Layer / n Koord Counter Laenge Liste Next Data ) (setq Liste (ssget "x" '((0 . "*")) )) (if (not (= Liste nil)) (progn (setq n 0) (setq Counter 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (while (< n Laenge) (setq Data (entget Next)) (setq Koord (cdr (assoc 8 Data))) (if (= Koord Layer) (progn (setq n (+ 10 Laenge)) ) ; progn (progn (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; progn ) ;if ) ; while ); progn ( (progn (print "Zeichnung ist leer ....") (exit) ) ) ) ; else (if (/= n (+ Laenge 10)) (progn (print "Kann kein Entity des gewünschten Layers finden -- Ende !!") (exit) ) ) (assoc 8 Data) ) (defun changeBlock ( / Next EListe KK Entity INext IData TmpE) ; ersten Block auf dubiose Weise holen ... ; .. und weiter, solange noch Bloecke da sein (setq Next (tblnext "BLOCK" T)) (while Next (setq KK(tblnext "BLOCK")) (setq Entity (cdr (assoc -2 Next))) (if Entity (progn ; in Liste einfuegen ... (setq EListe (cons Entity EListe)) (setq INext (entnext Entity)) (while INext (setq IData (entget INext)) (if IData (progn (setq EListe (cons INext EListe)) (setq TmpE (entnext INext)) (if (= TmpE INext) (setq INext nil) (setq Inext TmpE) ) ) ) ) ) ) (setq Next KK) ) (ListProc EListe) ) (defun ListProc (Liste / n Laenge Ent) (setq Laenge (length Liste)) (setq n 0) (princ Laenge) (while (< n Laenge) (setq Ent (nth n Liste)) (ent_modZ Ent 10 nil) (ent_modZ Ent 11 nil) (ent_modZ Ent 12 nil) (ent_modZ Ent 13 nil) (setq n (1+ n)) ) ) (defun init_err ( / ) (setq olderr *error*) (setq *error* fel_err) (setq ce (getvar "cmdecho")) (setvar "cmdecho" 0) (command "zurück" "m" ) (command "zurück" "b" ) ; Start ; (if (/= "AutoLISP Release 11.0" (ver) ) ; ) ; (if (= testedID 0) ; (progn ; (initLisp_intern) ; (initLisp_extern) ; (setq testedID 42) ; (setq verifyID 2904) ; ) ; ) ; (if (= testedID 42) ; (progn ; (initLisp_intern) ; (if (/= verifyID 2904) ; (licenceErr 5) ; ) ; ) ; ; else 42 ; (licenceErr 6) ; ) ; End ) (defun fel_err (status) (if (/= status "quit / exit abort") (progn (princ "\nFehler: ") (princ status) ) ) (princ "\nRückgängig machen ...") (command "zurück" "r") (setvar "cmdecho" ce) (setq *error* olderror) (princ ) ) (defun reset_err () (command "zurück" "e") (setvar "cmdecho" ce) (setq *error* olderror) ) (defun c:hmodins ( / Hoehe) (init_err) ;(initLisp_extern) (textpage) (princ "\nModifikation der Höhen aller eingefügten Blöcke") (princ "\n-----------------------------------------------\n") (setq Hoehe (getreal "\n\nNeue Höhe <0.0> : ")) (if (= Hoehe nil) (setq Hoehe 0.0)) (princ "\n") (Einfuege) (princ "\nEnde ;-)\n") (textscr) (reset_err) (princ ) ) (defun c:hmodall ( / Hoehe ModBHoehe) (init_err) ;(initLisp_extern) (textpage) (princ "\nModifikation der Höhen aller Zeichnungselemente") (princ "\n-----------------------------------------------\n") (setq Hoehe (getreal "\n\nNeue Höhe <0.0> : ")) (if (= Hoehe nil) (setq Hoehe 0.0)) (princ "\n") (princ "\nSollen zusätzlich die Entityhöhen von Blöcken auf 0.0") (setq ModBHoehe (getstring "\ngesetzt werden ? : ")) (if (= ModBHoehe "") (setq ModBHoehe "N")) (Linien) (Punkte) (Kreise) (Texte) (Boegen) (Shape) (Baender) (Flaechen) (Einfuege) (MPLine) (3DFlaeche) (if (/= ModBHoehe "n") (progn (princ "\nBlöcke werden durchsucht ... ") (setq Hoehe 0.0) (changeBlock) ) ) (princ "\nEnde ;-)\n") (textscr) (reset_err) (princ ) ) (defun Einfuege( / AllLines ) (setq AllLines (ssget "X" '((0 . "INSERT")))) (if (/= AllLines nil) (progn (princ "\nEingefügte Blöcke : ") (changeZ AllLines 10 nil) ) ) ) (defun Punkte( / AllLines ) (setq AllLines (ssget "X" '((0 . "POINT")))) (if (/= AllLines nil) (progn (princ "\nPunkte : ") (changeZ AllLines 10 nil) ) ) ) (defun Shape( / AllLines ) (setq AllLines (ssget "X" '((0 . "SHAPE")))) (if (/= AllLines nil) (progn (princ "\nShapes : ") (changeZ AllLines 10 nil) ) ) ) (defun Texte( / AllLines ) (setq AllLines (ssget "X" '((0 . "TEXT")))) (if (/= AllLines nil) (progn (princ "\nTexte : ") (changeZ AllLines 10 T) ) ) ) (defun Boegen( / AllLines ) (setq AllLines (ssget "X" '((0 . "ARC")))) (if (/= AllLines nil) (progn (princ "\nBögen : ") (changeZ AllLines 10 nil) ) ) ) (defun Kreise( / AllLines ) (setq AllLines (ssget "X" '((0 . "CIRCLE")))) (if (/= AllLines nil) (progn (princ "\nKreise : ") (changeZ AllLines 10 nil) ) ) ) (defun Linien( / AllLines ) (setq AllLines (ssget "X" '((0 . "LINE")))) (if (/= AllLines nil) (progn (princ "\nLinien Anfang : ") (changeZ AllLines 10 nil) (princ "\nLinien Ende : ") (changeZ AllLines 11 nil) ) ) ) (defun 3DFlaeche( / AllLines ) (setq AllLines (ssget "X" '((0 . "3DFACE")))) (if (/= AllLines nil) (progn (princ "\n3DFläche Punkt 1 : ") (changeZ AllLines 10 nil) (princ "\n3DFläche Punkt 2 : ") (changeZ AllLines 11 nil) (princ "\n3DFläche Punkt 3 : ") (changeZ AllLines 12 nil) (princ "\n3DFläche Punkt 4 : ") (changeZ AllLines 13 nil) ) ) ) (defun Flaechen( / AllLines ) (setq AllLines (ssget "X" '((0 . "SOLID")))) (if (/= AllLines nil) (progn (princ "\nFlächen Punkt 1 : ") (changeZ AllLines 10 nil) (princ "\nFlächen Punkt 2 : ") (changeZ AllLines 11 nil) (princ "\nFlächen Punkt 3 : ") (changeZ AllLines 12 nil) (princ "\nFlächen Punkt 4 : ") (changeZ AllLines 13 nil) ) ) ) (defun Baender( / AllLines ) (setq AllLines (ssget "X" '((0 . "TRACE")))) (if (/= AllLines nil) (progn (princ "\nBänder Punkt 1 : ") (changeZ AllLines 10 nil) (princ "\nBänder Punkt 2 : ") (changeZ AllLines 11 nil) (princ "\nBänder Punkt 3 : ") (changeZ AllLines 12 nil) (princ "\nBänder Punkt 4 : ") (changeZ AllLines 13 nil) ) ) ) (defun ent_modZ (Koord Marker TFlag / Data NewKoord LocalEnt TmpH) (setq Data (entget Koord)) (setq LocalEnt Koord) (setq Koord (assoc Marker Data)) (setq Counter 0) (if TFlag (progn (setq TmpH (- Hoehe (cadddr Koord))) (setq NewKoord (list 1.0 1.0 0.0)) (setq Data (reverse (append (list TmpH) (list 1.0 1.0) ))) (command "schieben" LocalEnt "" NewKoord Data) ) (progn ; else (setq NewKoord (list (car Koord) (cadr Koord) (caddr Koord) Hoehe)) (setq Data (subst NewKoord (assoc Marker Data) Data ) ) (entmod Data) ) ;progn ) ) (defun ent_modL (Koord Item / Data ) (setq Data (entget Koord)) (setq Koord (assoc 8 Data)) (setq Data (subst Item (assoc 8 Data) Data ) ) (entmod Data) ) (defun changeZ (Liste Marker LayFlg / n Counter Data Next Koord) (if (/= Liste nil) (progn (setq n 0) (setq Counter 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (princ Laenge) (while (< n Laenge) (ent_modZ Next Marker LayFlg) (setq n (1+ n)) (setq Next (ssname Liste n)) ) ) (print Counter) ) ) (defun DelItem (Item Liste / NewList Head) (setq NewList ()) (setq Head (car Liste)) (while (not (= Head nil)) (if (not (= Head Item)) (progn (setq NewList (cons Head NewList)) ) ) (setq Liste (cdr Liste)) (setq Head (car Liste)) ); while (setq Liste (reverse NewList)) ) (defun ClearPent ( Pent / Koord NewKoord ) (setq Koord (assoc 10 Pent)) (setq NewKoord (list (car Koord) (cadr Koord) (caddr Koord) Hoehe)) (setq Pent (subst NewKoord (assoc 10 Pent) Pent ) ) (setq Koord (assoc -1 Pent)) (setq Pent (DelItem Koord Pent)) (setq Koord (assoc -2 Pent)) (setq Pent (DelItem Koord Pent)) ) (defun MPLine( / PListe DelListe TmpCtr PMarker PLine L1 L2 Liste Next Laenge PType n Data) ; ist nur fuers TESTEN !!! (setq PMarker 10) ; Selektiere alle Polylinien ... (setq L1 (ssget "x" '((0 . "POLYLINE")) )) (setq L2 (ssget "x" '((0 . "LWPOLYLINE")) )) (setq Liste (MergeList L1 L2 T)) (if (not (= Liste nil)) (progn (setq PListe ()) (princ "\nPolyLinien : ") (setq n 0) (setq TmpCtr 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (while (< n Laenge) (setq Data (entget Next)) (setq PType (assoc 70 Data)) (setq Data (ClearPent Data)) (setq PListe (cons Data PListe) ) (setq DelListe (cons Next DelListe)) (setq TmpCtr (1+ TmpCtr)) ;ok, das war die PolyLine, jetzt die Vertexe ... (setq PLine (entnext Next)) (while (not (= PLine nil)) (setq Data (entget PLine)) (setq Data (ClearPent Data)) (setq PListe (cons Data PListe) ) (setq DelListe (cons PLine DelListe)) (setq PType (assoc 0 Data)) (if (= "VERTEX" (cdr PType)) (progn (setq Next (entnext PLine)) (setq PLine Next) ); if progn (progn (setq PLine nil) ) ;else progn ); closing if ); while (Vertex da) (setq PListe (reverse PListe)) (setq DelListe (reverse DelListe)) (FEntDel DelListe) (setq DelListe ()) (CreatePoly PListe) (setq PListe ()) (setq n (1+ n)) (setq Next (ssname Liste n)) ) (princ Laenge) ) ;(print Laenge) ) ) ;PolyLine (defun CreatePoly (Liste / Head ) (setq Head (car Liste)) (while (/= Head nil) (entmake Head) (setq Liste (cdr Liste)) (setq Head (car Liste)) ); while ) (defun FEntDel (Liste / Head) (foreach Head Liste (entdel Head)) ) (defun FLen (Liste / Head) (if (= Liste nil) (setq n 0) (progn (setq n 0) (setq n (foreach Head Liste (setq n (1+ n)))) ) ) ) (defun c:cl ( / ASatz Target) (init_err) ;(initLisp_extern) (princ "\nVerschieben von Zeichnungselementen auf einen neuen Layer") (princ "\n---------------------------------------------------------\n") (prompt "\nWählen Sie alle zu verschiebenden Objekte : ") (setq ASatz (ssget)) (prompt "\nWählen Sie _ein_ Objekt des Ziellayers : ") (setq Target (cdr (assoc 8 (entget (car (entsel)))))) (command "eigändr" ASatz "" "la" Target "") (princ) (reset_err) (princ) ) (defun expldim ( / Liste n Next Laenge ) (setq Liste (ssget "x" '((0 . "DIMENSION")))) (if (/= Liste nil) (progn (setq n 0) (setq Next (ssname Liste n)) (setq Laenge (sslength Liste)) (while (< n Laenge) (command "ursprung" Next ) (setq n (1+ n)) (setq Next (ssname Liste n)) ) ; while (princ "\nAnzahl der aufgelösten Bemaßungen : ") (princ Laenge) ); progn ); if ) ; ; ; (princ ".") (defun S::Startup () (init_err) (princ ) ; (initLisp_extern) (reset_err) (graphscr) (princ ) ) ; (defun setgrenz (alt) ; (command "zoom" "a") (setq ytra (car (getvar "EXTMIN"))) (setq xtra (cadr (getvar "EXTMIN"))) (setvar "LIMMIN" (list ytra xtra)) (setq ytra (car (getvar "EXTMAX"))) (setq xtra (cadr (getvar "EXTMAX"))) (setvar "LIMMAX" (list ytra xtra)) (command "zoom" "a") ; ) ; ; ; ; (defun C:abgriff (/ xp l) ; (init_err) (setq qq (open "acad.pch" "a")) (if (= qq nil) (progn (write-line " Datei ACAD.PCH konnte nicht geöffnet werden,") (write-line " Die Funktion wurde abgebrochen !") ) (progn (setq xp (getpoint " Bitte Punkt anklicken ... ")) (if (= xp nil) (write-line " Ungültige Punktauswahl !") (progn (setq xpz (caddr xp)) (if (= xpz nil) (setq xpz 0.0)) (setq sy (rtos (car xp) 2 3)) (setq sx (rtos (cadr xp) 2 3)) (setq sz (rtos xpz 2 3)) (while (< (strlen sy) 12) (setq sy (strcat " " sy))) (while (< (strlen sx) 12) (setq sx (strcat " " sx))) (while (< (strlen sz) 9) (setq sz (strcat " " sz))) (write-line (strcat " 2 " sy sx sz) qq) ) ) (close qq) ) ) (reset_err) ; ) ; ; (defun C:s_h (/ asatz) ; (init_err) (write-line " Bitte Objekt(e) anklicken ... ") (setq asatz (ssget)) (if (= asatz nil) (write-line " Ungültige Objektauswahl !") (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (setq lname (cdr (assoc 8 edefi))) (if (= (substr lname 1 1) "H") (progn (setq lname (strcat "S" lname)) (if (= (tblsearch "LAYER" lname) nil) (command "-layer" "n" lname "fr" lname "")) (setq edefi (subst (cons 8 lname) (assoc 8 edefi) edefi)) (entmod edefi) (redraw elent 1) ) ) (setq counter (+ counter 1)) ) ) ) (setq asatz nil) (reset_err) ; ) ; ; ; (defun C:shz (/ asatz) ; (init_err) (write-line " Bitte Objekt(e) anklicken ... ") (setq asatz (ssget)) (if (= asatz nil) (write-line " Ungültige Objektauswahl !") (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (setq lname (cdr (assoc 8 edefi))) (if (= (substr lname 1 2) "SH") (progn (setq lname (substr lname 2 (- (strlen lname) 1))) (if (= (tblsearch "LAYER" lname) nil) (command "-layer" "n" lname "")) (setq edefi (subst (cons 8 lname) (assoc 8 edefi) edefi)) (entmod edefi) (redraw elent 1) ) ) (setq counter (+ counter 1)) ) ) ) (setq asatz nil) (reset_err) ; ) ; ; (defun C:listen (/ ptx) ; (init_err) (setvar "COORDS" 1) (write-line "") (write-line " Bitte wählen Sie die Koordinatenart !") (write-line "") (write-line " 1 orthogonal") (write-line " 2 polar") (write-line "") (setq auswahl (getint " Ihre Eingabe <1> : ")) (IF (/= auswahl 2) (setq auswahl 1)) (write-line "") (write-line "") (write-line " Geben Sie die gewünschte Zeichenanzahl ein für ...") (write-line "") (setq numlen (getint " die Punktnummer <8> : ")) (if (= numlen NIL) (setq numlen 8)) (if (= auswahl 1) (progn (setq ylen (getint " den Rechtswert <12> : ")) (if (= ylen NIL) (setq ylen 12)) (setq xlen (getint " den Hochwert <12> : ")) (if (= xlen NIL) (setq xlen 12)) ) (progn (setq ylen (getint " die Richtung <10> : ")) (if (= ylen NIL) (setq ylen 10)) (setq xlen (getint " die Distanz <9> : ")) (if (= xlen NIL) (setq xlen 9)) ) ) (setq zlen (getint " die Höhe <9> : ")) (if (= zlen NIL) (setq zlen 9)) (write-line "") (write-line "") (setq zhoehe (getreal " Zeichengröße <1.6> : ")) (if (= zhoehe nil) (setq zhoehe 1.6)) (write-line "") (write-line "") (setq zabst (getreal " Zeilenabstand <3.2> : ")) (if (= zabst nil) (setq zabst 3.2)) (write-line "") (write-line "") (setq fnm (getstring " Lesen von Datei : ")) (write-line "") (write-line "") (if (/= fnm "") (progn (setq pos1 20) (setq pos2 32) (setq pos3 44) (setq pos4 53) (setq pos1 (- pos1 numlen)) (setq pos2 (- pos2 ylen)) (setq pos3 (- pos3 xlen)) (setq pos4 (- pos4 zlen)) (setq xpos 10000.0) (setq ptx (list 0.0 xpos)) (command "-layer" "m" "koords" "") (command "stil" "normal" "romans" zhoehe "0.9" "0.0" "n" "n" "n") ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line " DATEI NICHT GEFUNDEN ! ") (write-line "") (write-line "") (setq fi nil) ) (progn (setq zi (read-line fi)) (while zi (if (< numlen 10) (setq pnr (substr zi pos1 numlen)) (setq pnr (substr zi 10 10)) ) (if (= auswahl 1) (progn (if (< ylen 12) (setq yyn (substr zi pos2 ylen)) (setq yyn (substr zi 20 12)) ) (if (< xlen 12) (setq xxn (substr zi pos3 xlen)) (setq xxn (substr zi 32 12)) ) ) (progn (if (< ylen 10) (setq yyn (substr zi pos2 ylen)) (setq yyn (substr zi 22 10)) ) (if (< xlen 9) (setq xxn (substr zi pos3 xlen)) (setq xxn (substr zi 35 9)) ) ) ) (if (< zlen 9) (setq zzn (substr zi pos4 zlen)) (setq zzn (substr zi 44 9)) ) (while (< (strlen pnr) numlen) (setq pnr (strcat " " pnr))) (while (< (strlen yyn) ylen) (setq yyn (strcat " " yyn))) (while (< (strlen xxn) xlen) (setq xxn (strcat " " xxn))) (while (< (strlen zzn) zlen) (setq zzn (strcat " " zzn))) (setq zi (strcat pnr yyn xxn zzn)) (command "text" ptx "" zi) (setq xpos (- xpos zabst)) (setq ptx (list 0.0 xpos)) (setq zi (read-line fi)) ) (setgrenz 2) ) ) ) ) (reset_err) ) ; ; (defun C:grenzen (/ ytra xtra) ; (init_err) (setgrenz 1) (reset_err) ; ) ; ; ; (defun setsym (blk) ; (setq ix 1) (command "einfüge" blk pkt1 fkt "" symricht) ; ) ; ; (defun C:scala (/ xlay fakir asatz counter alt neu edefi asatzlen) ; (init_err) (textscr) (write-line "") (write-line "") (SETQ xlay (strcase (getstring " Bitte den gewünschten Layernamen eingeben : "))) (if (/= xlay "") (progn (write-line "") (write-line " Bitte geben Sie ein ... ") (write-line "") (write-line " 1 für Symbole") (write-line " 2 für Text") (write-line "") (SETQ hallo (getint " Ihre Eingabe <1> : ")) (write-line "") (IF (/= hallo 2) (SETQ hallo 1)) (SETQ asatz (ssget "X" (list (cons 8 xlay)))) (if (/= asatz NIL) (progn (SETQ asatzlen (sslength asatz)) (SETQ scount 0) (SETQ counter 0) (WHILE (< counter asatzlen) (SETQ edefi (entget (SETQ elent (ssname asatz counter)))) (IF (= hallo 2) (IF (= (cdr (assoc 0 edefi)) "TEXT") (progn (SETQ xf (cdr (assoc 40 edefi))) (IF (/= xf NIL) (progn (SETQ zf xf) (SETQ scount (+ scount 1)) ) ) ) ) (IF (= (cdr (assoc 0 edefi)) "INSERT") (progn (SETQ xf (cdr (assoc 41 edefi))) (IF (/= xf NIL) (progn (SETQ zf xf) (SETQ scount (+ scount 1)) ) ) ) ) ) (SETQ counter (+ counter 1)) ) (write-line (strcat " Elemente auf Layer : " (itoa asatzlen))) (write-line (strcat " Scalierbare Elemente : " (itoa scount))) (write-line "") (if (/= scount 0) (progn (write-line (strcat " Der aktuelle Skalierfaktor ist : " (rtos zf 2 2))) (write-line "") (setq fakir (getreal " Bitte den neuen Skalierfaktor eingeben : ")) (write-line "") (if (= fakir nil) (setq fakir zf)) (write-line " Korrekturbetrag der Drehrichtung ") (setq dreher (getreal " (in Neugrad gegen Uhrzeigersinn) eingeben : ")) (if (= dreher nil) (setq dreher 0.0) (progn (setq dreher (* (/ dreher 200.0) pi)) (while (>= dreher (* pi 2.0)) (setq dreher (- dreher (* pi 2.0)))) ) ) ; (write-line "") (SETQ counter 0) (WHILE (< counter asatzlen) (SETQ edefi (entget (SETQ elent (ssname asatz counter)))) (IF (= hallo 2) (IF (= (cdr (assoc 0 edefi)) "TEXT") (progn (setq chang 0) (setq xf (cdr (assoc 40 edefi))) (if (/= xf nil) (progn (setq edefi (subst (cons 40 fakir) (assoc 40 edefi) edefi)) (setq chang 1) ) ) (if (/= dreher 0.0) (progn (setq xf (cdr (assoc 50 edefi))) (setq xdreher (+ xf dreher)) (while (>= xdreher (* pi 2.0)) (setq xdreher (- xdreher (* pi 2.0)))) (setq edefi (subst (cons 50 xdreher) (assoc 50 edefi) edefi)) (setq chang 1) ) ) (if (= chang 1) (progn (entmod edefi) (redraw elent 1) ) ) ) ) (IF (= (cdr (assoc 0 edefi)) "INSERT") (progn (setq chang 0) (SETQ xf (cdr (assoc 41 edefi))) (IF (/= xf NIL) (progn (SETQ edefi (subst (cons 41 fakir) (assoc 41 edefi) edefi)) (SETQ edefi (subst (cons 42 fakir) (assoc 42 edefi) edefi)) (SETQ edefi (subst (cons 43 fakir) (assoc 43 edefi) edefi)) (setq chang 1) ) ) (if (/= dreher 0.0) (progn (setq xf (cdr (assoc 50 edefi))) (setq xdreher (+ xf dreher)) (while (>= xdreher (* pi 2.0)) (setq xdreher (- xdreher (* pi 2.0)))) (setq edefi (subst (cons 50 xdreher) (assoc 50 edefi) edefi)) (setq chang 1) ) ) (if (= chang 1) (progn (entmod edefi) (redraw elent 1) ) ) ) ) ) (SETQ counter (+ counter 1)) ) ) (write-line " Keine scalierbaren Elemente gefunden ! ") ) ) ) (if (= asatz NIL) (progn (write-line " Layer nicht vorhanden oder keine Elemente gefunden,") (write-line " die Funktion wurde abgebrochen !") ) ) (write-line "") ) ) (SETQ asatz NIL) (reset_err) ; ) ; ; (defun C:texass (/ xpkt) ; (init_err) (write-line "") (SETQ xlay (strcase (getstring " Text eingeben : "))) (if (/= xlay "") (progn (SETQ xposi (getreal " x - Position : ")) (SETQ yposi (getreal " y - Position : ")) (SETQ zposi (getreal " Texthöhe : ")) (write-line "") (write-line " Bitte geben Sie ein ... ") (write-line "") (write-line " 1 für linksorientiert") (write-line " 2 für mittig") (write-line " 3 für rechtsorientiert") (write-line "") (SETQ hallo (getint " Ihre Eingabe <1> : ")) (write-line "") (if (= hallo 2) (setq exx "tc") (if (= hallo 3) (setq exx "tr") (setq exx "tl"))) ; (setq xpkt (list xposi yposi)) (command "text" "p" exx xpkt zposi 0.0 xlay) (setq yuanz 3) (setq xuanz 3) (setq abst (/ zposi 30.0)) (command "reihe" (entlast) "" "r" yuanz xuanz abst abst) ; ) ) (SETQ asatz NIL) (reset_err) ; ) ; ; (defun C:uralt (/ l1 l2 bsatz counter bsatzlen) ; (init_err) (textscr) (write-line "") (write-line " Bitte geben Sie ein ... ") (write-line "") (write-line " 1 für Blöcke auflösen") (write-line " 2 für Polylinien auflösen") (write-line "") (setq hallo (getint " Ihre Eingabe <1> : ")) (write-line "") (if (/= hallo 2) (setq hallo 1)) (if (= hallo 1) (setq bsatz (ssget "X" '((0 . "INSERT")))) (progn (setq l1 (ssget "x" '((0 . "POLYLINE")))) (setq l2 (ssget "x" '((0 . "LWPOLYLINE")))) (setq bsatz (MergeList l1 l2 T)) ) ) (if (/= bsatz NIL) (progn (setq bsatzlen (sslength bsatz)) (setq scount 0) (setq counter 0) (if (= hallo 1) (write-line (strcat " Anzahl der Blöcke : " (itoa bsatzlen))) (write-line (strcat " Anzahl der Polylinien : " (itoa bsatzlen))) ) (while (< counter bsatzlen) (setq elent (ssname bsatz counter)) (command "ursprung" elent) (setq counter (+ counter 1)) ) (graphscr) (setq bsatz nil) ) ) (write-line "") (reset_err) ) ; ; ; ; ; kart - AutoCAD - Befehl zum Einlesen ; von Linien und Symbolen aus Tachymeteraufnahme ; mit variabler Layerauswahl ; ; neue Code- und Blockdefinitionen (März 2001) ; ; aktuelle Variante ; ; (defun C:kart () ; (init_err) (textscr) (setq hset 0) ; (setq gesetzt (getvar "CLAYER")) (setq fh (open "LAYER.TAB" "w")) (setq mitgitter 0) (if (/= fh nil) (progn (setq edefi2 (tblnext "LAYER" "1")) (while (/= edefi2 nil) (setq lname (cdr (assoc 2 edefi2))) (if (= lname "GITTER") (setq mitgitter 1)) (while (< (strlen lname) 40) (setq lname (strcat lname " "))) (setq lflag (itoa (cdr (assoc 70 edefi2)))) (while (< (strlen lflag) 4) (setq lflag (strcat " " lflag))) (write-line (strcat lname lflag) fh) (setq edefi2 (tblnext "LAYER")) ) (close fh) ) ) ; (write-line "") (setq mst (getint "Maßstab 1 : XXXX <250> : ")) (if (= mst nil) (setq mst 250.0)) (write-line "") (setq abst (fix (/ mst 10))) (setq fkt (/ mst 714.28571)) (setq zusch (/ mst 750.0)) (setq hscala (/ mst 666.6667)) ; ; Sicherung der zu verändernden Systemvariablen ; (setq save01 (getvar "AUNITS")) (setq save02 (getvar "ANGBASE")) (setq save03 (getvar "ANGDIR")) (setq save04 (getvar "SPLINETYPE")) (setq save05 (getvar "DRAGMODE")) (setq save06 (getvar "REGENMODE")) (setq save07 (getvar "OSMODE")) ; ; Setzen der Variablen ; (setvar "AUNITS" 2) (setvar "ANGDIR" 1) (setvar "ANGBASE" (/ pi 2.0)) (setvar "SPLINETYPE" 6) (setvar "cmdecho" 0) (setvar "DRAGMODE" 0) (setvar "REGENMODE" 0) (setvar "OSMODE" 0) ; (setq richt (getreal "Textrichtung <0> : ")) (if (= richt nil) (setq richt 100.0) (setq richt (- 500.0 richt))) (if (>= richt 400.0) (setq richt (- richt 400.0))) (write-line "") ; ; Berechnung der Verschiebemaße für die Beschriftungen ; (setq willxo (* (sin (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willyo (* (cos (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willxu (* (sin (* (/ (+ richt 12.0) 200.0) pi)) zusch)) (setq willyu (* (cos (* (/ (+ richt 12.0) 200.0) pi)) zusch)) ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 Einzelpunkte ") (write-line " 2 Linien ") (write-line " 4 Punktnummern ") (write-line " 8 Höhen ") (write-line "") (setq auswahl (getint "Ihre Eingabe <3> : ")) (if (= auswahl nil) (setq auswahl 3)) (write-line "") ; (write-line "Bitte wählen Sie aus :") (write-line "") (write-line " 1 mit Raster setzen") (write-line " 2 ohne Raster setzen") (write-line "") (setq rasta (getint "Ihre Eingabe <2> : ")) (write-line "") (IF (/= rasta 2) (setq rasta 2)) ; ; (setq offen 2) (if (/= auswahl 0) (progn (setq einzel (boole 1 auswahl 1)) (setq linien (boole 1 auswahl 2)) (setq nummern (boole 1 auswahl 4)) (setq hoehen (boole 1 auswahl 8)) ; (command "stil" "normal" "romans" "0.0" "1.0" "" "" "" "") (command "farbe" "vonlayer") (setq fnm (getstring "Lesen von Datei : ")) (write-line "") ; (if (/= fnm "") (progn ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line (strcat " Datei " fnm " wurde nicht gefunden ! ")) (write-line "") (graphscr) ) (progn ; ; Einlesen der Linien (Höhenschichtlinien als Polylinie) ; (setq offen 1) (if (= linien 2) (progn (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") (setq polylin 0) (setq altlnum 0) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (if (/= (substr zi 66 3) " 0") (progn ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq lnum (atoi (substr zi 53 4))) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq bog (atoi (substr zi 65 1))) (setq pkt1 (list xxx yyy)) ; ; (if (/= lnum 0) (progn (if (= bog 1) ; BOGENANFANG (setq banfpkt pkt1) ) ; (if (= lnum altlnum) (progn ; (if (< bog 2) (progn (if (= polylin 0) (command "linie" pkt2 pkt1 "") (progn (if (= larc 1) (command "l")) (setq larc 0) (command pkt1) ) ) ) ) ; (if (>= bog 3) (progn (if (= lcode "199") (progn (setq vfkt (* (distance banfpkt pkt1) 0.5)) (setq symricht (- 400.0 (* (/ (angle banfpkt pkt1) pi) 200.0))) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (command "einfüge" "zaun1" pkt2 vfkt "" symricht) ) (progn (if (= polylin 0) (command "bogen" banfpkt pkt2 pkt1) (progn (if (= larc 0) (command "k")) (command "p" pkt2 pkt1) (setq larc 1) ) ) (if (= bog 4) (setq banfpkt pkt1)) ) ) ) ) ; ) (progn (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) (command "-layer" "m" lcode "") (setq polylin 0) (setq larc 0) (if (= lcode "100") (setq polylin 1)) (if (= lcode "101") (setq polylin 1)) (if (= lcode "102") (setq polylin 1)) (if (= polylin 1) (command "plinie" pkt1)) ) ) ) ) ; ; (setq altlnum lnum) (setq pkt2 pkt1) ) ) ) ) (setq zi (read-line fi)) ) (close fi) (setq offen 0) (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) ) ) ; ; Einlesen der Einzelpunkte, Höhen und Nummern ; (if (/= auswahl 2) (progn (if (= offen 0) (progn (setq fi (open fnm "r")) (setq offen 1) ) (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") ) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (setq pnr (substr zi 7 13)) (setq ende 1) (while ende (if (= (substr pnr 1 1) " ") (setq pnr (substr pnr 2 (1- (strlen pnr)))) (setq ende nil) ) ) ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq sym (substr zi 60 3)) (setq ende 1) (while ende (if (= (substr sym 1 1) " ") (setq sym (substr sym 2 (1- (strlen sym)))) (setq ende nil) ) ) ; (if (> (strlen zi) 68) (setq symricht (atof (substr zi 69 10))) (setq symricht 0.0) ) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq mitnum 0) (setq xnum 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xnum 0)) ) (if (= nummern 4) (if (/= pnr "") (if (= xnum 1) (if (= auswahl 4) (setq mitnum 1) (progn (if (= linien 2) (setq mitnum 1)) (if (/= sym "") (if (= einzel 1) (setq mitnum 1)) ) ) ) ) ) ) ; (setq mithoeh 0) (setq xhoeh 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xhoeh 0)) ) (if (= hoehen 8) (if (/= lcode "199") (if (= xhoeh 1) (if (/= zzz 0.0) (if (= auswahl 8) (setq mithoeh 1) (progn (if (= linien 2) (setq mithoeh 1)) (if (/= sym "") (if (= einzel 1) (setq mithoeh 1)) ) ) ) ) ) ) ) ; (setq pkt1 (list xxx yyy)) ; ; ; (if (= mitnum 1) (progn (if (= hset 0) (setq hset 2) (if (= hset 1) (setq hset 3) ) ) (if (/= sym "") (progn (setq numlay "einzelnum") (if (= sym "6") (setq numlay "grenznum")) (if (= sym "7") (setq numlay "grenznum")) (if (= (substr sym 1 2) "43") (setq numlay "snum")) (command "-layer" "m" numlay "") ) (progn (command "-layer" "m" "krznum" "" "einfüge" "nkrz" pkt1 fkt "" richt) (setq numlay "sonstnum") (if (= lcode "13") (setq numlay "gebnum")) (if (= lcode "2") (setq numlay "boeschnum")) (if (= lcode "3") (setq numlay "boeschnum")) (if (= lcode "4") (setq numlay "boeschnum")) (if (= lcode "21") (setq numlay "stranum")) (if (= lcode "22") (setq numlay "stranum")) (if (= lcode "23") (setq numlay "stranum")) (if (= lcode "24") (setq numlay "stranum")) (if (= lcode "25") (setq numlay "stranum")) (if (= lcode "26") (setq numlay "stranum")) (if (= lcode "27") (setq numlay "stranum")) (if (= lcode "28") (setq numlay "stranum")) (if (= lcode "6") (setq numlay "grenznum")) (if (= lcode "7") (setq numlay "grenznum")) (command "-layer" "m" numlay "") ) ) (if (and (/= sym "99") (/= sym "991") (/= sym "8")) (progn (setq txp1 (+ xxx (* willxu 1.5))) (setq txp2 (+ yyy (* willyu 1.5))) (setq txp (list txp1 txp2)) (command "text" "p" "ol" txp (* zusch 1.8) richt pnr) ) ) ) ) ; ; (if (= mithoeh 1) (progn (if (= sym "") (progn (command "-layer" "m" (strcat "H" lcode) "") (command "einfüge" "hkrz" pkt1 fkt "" richt) ) (command "-layer" "m" (strcat "H" sym) "") ) (if (= hset 0) (setq hset 1) (if (= hset 2) (setq hset 3) ) ) (setq txp1 (+ xxx (* willxo 1.12))) (setq txp2 (+ yyy (* willyo 1.12))) (setq txp (list txp1 txp2)) (command "text" txp hscala richt (rtos zzz 2 2)) ; ; --> die letzte Ziffer n bei (rtos zzz 2 n) bedeutet die Anzahl der Nachkommastellen ! ; ) ) ; ; (if (= einzel 1) (if (/= sym "") (progn ; ; SYMBOLCODES SETZEN ; (command "-layer" "m" sym "") ; (setq ix 0) ; (if (= sym "1") ; Heizungsschacht (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "hzgs") ) ) ; (if (= sym "6" ) (setsym "grenz1")) ; GRENZPUNKT aufgemessen (if (= sym "7" ) (setsym "grenz2")) ; GRENZPUNKT übernommen (if (= sym "701" ) (setsym "grenz3")) ; GRENZPUNKT nicht abgemarkt ; (if (= sym "8") ; TP (progn (setsym "tpkt") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "9") ; FERNMELDESCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "fms") ) ) ; (if (= sym "10") (setsym "nbaum")) ; NADELBAUM (if (= sym "11") (setsym "lbaum")) ; LAUBBAUM (if (= sym "119") (setsym "stumpf")) ; BAUMSTUMPF (if (= sym "111") (setsym "obaum")) ; OBSTBAUM (if (= sym "12") (setsym "heckp")) ; HECKENPUNKT (if (= sym "121") (setsym "gebue-gm")); GEBÜSCH gemessen (if (= sym "19") (setsym "hfp")) ; HÖHENFESTPUNKT / MB (if (= sym "191") (setsym "MB")) ; HÖHENFESTPUNKT / MB (if (= sym "21") (setsym "fahrbm")) ; FAHRBAHNMITTE (if (= sym "282") (setsym "PFEIL-HR")); PFEIL HALBRECHTS (if (= sym "30") (setsym "verkz1")) ; VERKEHRSZEICHEN (if (= sym "301") (setsym "verkz4")) ; HINWEISSCHILD (if (= sym "302") (setsym "strs")) ; STRASSENNAME (if (= sym "303") (setsym "hst")) ; HALTESTELLE (if (= sym "31") (setsym "verkz2")) ; AMPEL (if (= sym "311") (setsym "sig")) ; SIGNAL (if (= sym "312") (setsym "schranke")); SCHRANKE (if (= sym "313") (setsym "wbake")) ; WARNBAKE (if (= sym "314") (setsym "wkreuz")) ; WARN-/ANDREASKREUZ (if (= sym "321") (setsym "kms1")) ; KILOMETERSTEIN Straße (if (= sym "322") (setsym "kms2")) ; KILOMETERSTEIN Eisenbahn (if (= sym "323") (setsym "station")) ; STATIONSZEICHEN (if (= sym "33") (setsym "verkz3")) ; ORTSDURCHFAHRTSSCHILD (if (= sym "34") (setsym "sohle")) ; BACHSOHLE (if (= sym "35") (setsym "rs")) ; ROHRSOHLE (if (= sym "36") (setsym "fmast")) ; FAHNENMAST ; (if (= sym "37") ; ANSCHLAGSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "ans") ) ) ; (if (= sym "38") ; WASSERSCHACHT rechteckig (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "wscha1") ) ) ; (if (= sym "381") ; WASSERSCHACHT rund (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "wscha2") ) ) ; (if (= sym "382") (setsym "rst")) ; ROHRSTUTZEN ; (if (= sym "39") (setsym "dkm")) ; DENKMAL (if (= sym "40") (setsym "br1")) ; SPRINGBRUNNEN (if (= sym "41") (setsym "ws")) ; WASSERSCHIEBER (if (= sym "411") (setsym "as")) ; ABWASSERSCHIEBER (if (= sym "412") (setsym "has")) ; WASSERSCHIEBER (if (= sym "42") (setsym "hydr1")) ; ÜBERFLURHYDRANT (if (= sym "431") (setsym "schacht1")); ABWASSERSCHACHT rund (if (= sym "432") (setsym "schacht2")); ABWASSERSCHACHT rechteckig (if (= sym "433") (setsym "schacht3")); EINLAUFSCHACHT rund (if (= sym "434") (setsym "schacht4")); EINLAUFSCHACHT rechteckig (if (= sym "435") (setsym "Dscha")) ; DRAINAGESCHACHT (if (= sym "44") (setsym "einl1")) ; EINLAUF (if (= sym "441") (setsym "einl2")) ; STRASSENEINLAUF (if (= sym "442") (setsym "einl3")) ; SEITENEINLAUF (if (= sym "45") (setsym "hydr2")) ; UNTERFLURHYDRANT (if (= sym "50") (setsym "mast1")) ; STAHLGITTERMAST (if (= sym "51") (setsym "mast2")) ; STAHLROHRMAST (if (= sym "52") (setsym "mast3")) ; BETONMAST (if (= sym "53") (setsym "mast4")) ; HOLZMAST (if (= sym "507") (setsym "lmast1")) ; STAHLGITTERMAST mit Leuchte (if (= sym "517") (setsym "lmast2")) ; STAHLROHRMAST mit Leuchte (if (= sym "527") (setsym "lmast3")) ; BETONMAST mit Leuchte (if (= sym "537") (setsym "lmast4")) ; HOLZMAST mit Leuchte ; (if (= sym "54") ; KABELSCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "ksch") ) ) ; (if (= sym "541") ; KABELSCHACHT doppelt (progn (if (> symricht 150.0) (if (< symricht 350.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (if (>= symricht 350.0) (setsym "ksch2") (if (<= symricht 50.0) (setsym "ksch2") (setsym "ksch1") ) ) ) ) ; (if (= sym "542") (setsym "k-lsa")) ; KABELSCHACHT LSA ; (if (= sym "55") (setsym "kabst")) ; KABELSTEIN ; (if (= sym "551") ; PRELLSTEIN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "prell") ) ) ; (if (= sym "56") ; SCHALTKASTEN (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "schk") ) ) ; (if (= sym "561") ; SCHALTKASTEN / ELT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "elt") ) ) ; (if (= sym "562") ; SCHALTKASTEN / TEL (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-tel") ) ) ; (if (= sym "563") ; SCHALTKASTEN / TV (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-TV") ) ) ; (if (= sym "57") (setsym "lat")) ; LATERNE (if (= sym "571") (setsym "scheinw")) ; SCHEINWERFER ; (if (= sym "58") ; RUFSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "rufs") ) ) ; (if (= sym "595") (setsym "ltg")) ; UK Elektroleitung (if (= sym "596") (setsym "fd")) ; UF Fahrdraht ; (if (= sym "61") (setsym "planke")) ; LEITPLANKE (if (= sym "622") (setsym "spf1")) ; SPERRPFOSTEN (if (= sym "623") (setsym "spf2")) ; HšLSE FšR SPERRPFOSTEN (if (= sym "64") (setsym "gass")) ; GASSÄULE / MERKSTEIN ; (if (= sym "651") ; PARKUHR (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (+ symricht 200.0))) ) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (setsym "puhr") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "p-autom") ) ) ; (if (= sym "67") (setsym "gwt")) ; GASWASSERTOPF ; (if (= sym "74") ; TRANSFORMATORENHÄUSCHEN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "trafo") ) ) ; (if (= sym "76") (setsym "oel")) ; OELABSCHEIDER (if (= sym "761") (setsym "benzin")) ; BEZINABSCHEIDER ; (if (= sym "79") ; TELEFONZELLE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "tele") ) ) ; (if (= sym "70") (setsym "poll")) ; POLLER (if (= sym "71") (setsym "sohle")) ; SOHLE (if (= sym "80") (setsym "br2")) ; BRUNNEN öffentl. Wasservers. (if (= sym "82") (setsym "okwasser")); WASSERSPIEGEL ; (if (= sym "83") ; BRIEFKASTEN (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "briefk") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "p-autom") ) ) ; (if (= sym "84") (setsym "stütze")) ; STÜTZE (if (= sym "89") (setsym "klgr")) ; KLÄRGRUBE rund (if (= sym "891") (setsym "klgr1")) ; KLÄRGRUBE variabel (if (= sym "90") (setsym "wass")) ; WASSERSÄULE (if (= sym "901") (setsym "luf")) ; ENTLÜFTUNG (if (= sym "91") (setsym "gs")) ; GASSCHIEBER (if (= sym "921") (setsym "bohr1")) ; KERNBOHRPUNKT (if (= sym "922") (setsym "bohr2")) ; BOHRPUNKT (if (= sym "923") (setsym "bohr3")) ; PEGELBOHRPUNKT (if (= sym "93") (setsym "ok")) ; OBERKANTE (if (= sym "931") (setsym "okfeg")) ; OBERKANTE FB EG (if (= sym "932") (setsym "okfkg")) ; OBERKANTE FB KG (if (= sym "933") (setsym "eg")) ; OBERKANTE EINGANG (if (= sym "934") (setsym "kf")) ; OBERKANTE KELLERFENSTER (if (= sym "94") (setsym "uk")) ; UNTERKANTE (if (= sym "95") (setsym "fallr")) ; FALLROHR (if (= sym "97") (setsym "flmst")) ; FLUTLICHTMAST ; (if (= sym "99") ; POLYGONPUNKT (progn (setsym "pp") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "991") ; AP (progn (setsym "ap") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= ix 0) (progn (setq symricht richt) (setsym "pkt") ) ) ) ) ) ) ) ; (setq zi (read-line fi)) ) (close fi) (setq offen 0) ) ) ) ) ) (progn (write-line " Kein Dateiname eingegeben ! ") (write-line "") (graphscr) ) ) ) ) ; ; LIMITEN ANPASSEN ; (setq minx (car (getvar "EXTMIN"))) (setq miny (cadr (getvar "EXTMIN"))) (setq maxx (car (getvar "EXTMAX"))) (setq maxy (cadr (getvar "EXTMAX"))) (setvar "LIMMIN" (list minx miny)) (setvar "LIMMAX" (list maxx maxy)) ; ; LÖSCHEN DER ALTEN GITTERKREUZE ; (setq asatz (ssget "X" '((8 . "GITTER")))) (if (/= asatz nil) (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (if (= (cdr (assoc 0 edefi)) "INSERT") (entdel (ssname asatz counter))) (setq counter (1+ counter)) ) (setq asatz nil) ) ) ; ; Setzen der neuen Gitterkreuze ; (if (= rasta 1) (if (> maxx minx) (progn (command "limiten" "aus") (if (= offen 2) (command "-layer" "t" "*" "ei" "*" "") (if (= mitgitter 1) (command "-layer" "t" "gitter" "")) ) ; (setq xuanz (fix (/ (- maxx minx) abst))) (setq yuanz (fix (/ (- maxy miny) abst))) (setq xmi (* abst (fix (/ minx abst)) 1.0)) (setq ymi (* abst (fix (/ miny abst)) 1.0)) ; (setq pt3 (list xmi ymi)) (command "-layer" "m" "gitter" "") (command "einfüge" "krz" pt3 fkt "" "") (command "reihe" (entlast) "" "r" (+ yuanz 2) (+ xuanz 2) abst abst) ) ) ) ; ; Wiederherstellen der Systemvariablen ; (if (= offen 2) (if (= hset 0) (command "-layer" "se" "0" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "*num" "") (command "-layer" "se" "0" "fr" "*num" "fr" "h*" "") ) ) ) ; (if (= hset 0) (command "-layer" "se" "0" "fr" "gitter" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "gitter" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "") (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "fr" "h*" "") ) ) ) ) ; (setq neusetz (getvar "clayer")) (if (/= gesetzt neusetz) (progn (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (= lname gesetzt) (progn (if (= (boole 1 flaggy 1) 1) (command "-layer" "t" lname "")) (command "-layer" "se" lname "") (setq zh nil) ) (setq zh (read-line fh)) ) ) (close fh) ) ) ) ) (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (if (/= zh nil) (progn (command "-layer") (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (/= gesetzt lname) (if (= (boole 1 flaggy 1) 1) (command "fr" lname) (command "t" lname) ) ) (setq zh (read-line fh)) ) (command "") ) ) (close fh) ) ) (command "DEL" "LAYER.TAB") (setvar "REGENMODE" 1) (command "zoom" "a") ; (setvar "DRAGMODE" save05) (setvar "REGENMODE" save06) (setvar "AUNITS" save01) (setvar "ANGBASE" save02) (setvar "ANGDIR" save03) (setvar "SPLINETYPE" save04) (setvar "OSMODE" save07) ; (setq rasta nil) (reset_err) ; ) ; ; ; ; kart - AutoCAD - Befehl zum Einlesen ; von Linien und Symbolen aus Tachymeteraufnahme ; mit variabler Layerauswahl ; ; neue Code- und Blockdefinitionen (Juni 1994) ; ; Variante mit 3d-Einlesen und alten Bloecken ; (defun C:kart3d () ; (init_err) (textscr) (setq hset 0) ; (setq gesetzt (getvar "CLAYER")) (setq fh (open "LAYER.TAB" "w")) (setq mitgitter 0) (if (/= fh nil) (progn (setq edefi2 (tblnext "LAYER" "1")) (while (/= edefi2 nil) (setq lname (cdr (assoc 2 edefi2))) (if (= lname "GITTER") (setq mitgitter 1)) (while (< (strlen lname) 40) (setq lname (strcat lname " "))) (setq lflag (itoa (cdr (assoc 70 edefi2)))) (while (< (strlen lflag) 4) (setq lflag (strcat " " lflag))) (write-line (strcat lname lflag) fh) (setq edefi2 (tblnext "LAYER")) ) (close fh) ) ) ; (write-line "") (setq mst (getint "Maßstab 1 : XXXX <250> : ")) (if (= mst nil) (setq mst 250.0)) (write-line "") (setq abst (fix (/ mst 10))) (setq fkt (/ mst 714.28571)) (setq zusch (/ mst 750.0)) (setq hscala (/ mst 666.6667)) ; ; Sicherung der zu verändernden Systemvariablen ; (setq save01 (getvar "AUNITS")) (setq save02 (getvar "ANGBASE")) (setq save03 (getvar "ANGDIR")) (setq save04 (getvar "SPLINETYPE")) (setq save05 (getvar "DRAGMODE")) (setq save06 (getvar "REGENMODE")) (setq save07 (getvar "OSMODE")) ; ; Setzen der Variablen ; (setvar "AUNITS" 2) (setvar "ANGDIR" 1) (setvar "ANGBASE" (/ pi 2.0)) (setvar "SPLINETYPE" 6) (setvar "CMDECHO" 0) (setvar "DRAGMODE" 0) (setvar "REGENMODE" 0) (setvar "OSMODE" 0) ; (setq richt (getreal "Textrichtung <0> : ")) (if (= richt nil) (setq richt 100.0) (setq richt (- 500.0 richt))) (if (>= richt 400.0) (setq richt (- richt 400.0))) (write-line "") ; ; Berechnung der Verschiebemaße für die Beschriftungen ; (setq willxo (* (sin (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willyo (* (cos (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willxu (* (sin (* (/ (+ richt 12.0) 200.0) pi)) zusch)) (setq willyu (* (cos (* (/ (+ richt 12.0) 200.0) pi)) zusch)) ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 Einzelpunkte ") (write-line " 2 Linien ") (write-line " 4 Punktnummern ") (write-line " 8 Höhen ") (write-line "") (setq auswahl (getint "Ihre Eingabe <3> : ")) (if (= auswahl nil) (setq auswahl 3)) (write-line "") ; (write-line "Bitte wählen Sie aus :") (write-line "") (write-line " 1 mit Raster setzen") (write-line " 2 ohne Raster setzen") (write-line "") (setq rasta (getint "Ihre Eingabe <2> : ")) (write-line "") (IF (/= rasta 2) (setq rasta 2)) ; ; (setq offen 2) (if (/= auswahl 0) (progn (setq einzel (boole 1 auswahl 1)) (setq linien (boole 1 auswahl 2)) (setq nummern (boole 1 auswahl 4)) (setq hoehen (boole 1 auswahl 8)) ; (command "stil" "normal" "romans" "0.0" "1.0" "" "" "" "") (command "farbe" "vonlayer") (setq fnm (getstring "Lesen von Datei : ")) (write-line "") ; (if (/= fnm "") (progn ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line (strcat " Datei " fnm " wurde nicht gefunden ! ")) (write-line "") (graphscr) ) (progn ; ; Einlesen der Linien (Höhenschichtlinien als Polylinie) ; (setq offen 1) (if (= linien 2) (progn (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") (setq polylin 0) (setq altlnum 0) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (if (/= (substr zi 66 3) " 0") (progn ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq lnum (atoi (substr zi 53 4))) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq bog (atoi (substr zi 65 1))) (setq pkt1 (list xxx yyy zzz)) (setq pkt3 (list xxx yyy)) ; ; (if (/= lnum 0) (progn (if (= bog 1) ; BOGENANFANG (setq banfpkt pkt1) ) ; (if (= lnum altlnum) (progn ; (if (< bog 2) (progn (if (= polylin 0) (command "linie" pkt2 pkt1 "") (progn (if (= larc 1) (command "li")) (setq larc 0) (command pkt3) ) ) ) ) ; (if (>= bog 3) (progn (if (= lcode "199") (progn (setq vfkt (* (distance banfpkt pkt1) 0.5)) (setq symricht (- 400.0 (* (/ (angle banfpkt pkt1) pi) 200.0))) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (command "einfüge" "zaun1" pkt2 vfkt "" symricht) ) (progn (if (= polylin 0) (command "bogen" banfpkt pkt2 pkt1) (progn (if (= larc 0) (command "k")) (command "p" pkt4 pkt3) (setq larc 1) ) ) (if (= bog 4) (setq banfpkt pkt1)) ) ) ) ) ; ) (progn (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) (command "-layer" "m" lcode "") (setq polylin 0) (setq larc 0) (if (= lcode "100") (setq polylin 1)) (if (= lcode "101") (setq polylin 1)) (if (= polylin 1) (command "plinie" pkt3)) ) ) ) ) ; ; (setq altlnum lnum) (setq pkt2 pkt1) (setq pkt4 pkt3) ) ) ) ) (setq zi (read-line fi)) ) (close fi) (setq offen 0) (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) ) ) ; ; Einlesen der Einzelpunkte, Höhen und Nummern ; (if (/= auswahl 2) (progn (if (= offen 0) (progn (setq fi (open fnm "r")) (setq offen 1) ) (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") ) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (setq pnr (substr zi 7 13)) (setq ende 1) (while ende (if (= (substr pnr 1 1) " ") (setq pnr (substr pnr 2 (1- (strlen pnr)))) (setq ende nil) ) ) ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq sym (substr zi 60 3)) (setq ende 1) (while ende (if (= (substr sym 1 1) " ") (setq sym (substr sym 2 (1- (strlen sym)))) (setq ende nil) ) ) ; (if (> (strlen zi) 68) (setq symricht (atof (substr zi 69 10))) (progn (if (= sym "44") (setq symricht 100.0) (setq symricht 0.0)) ) ) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq mitnum 0) (setq xnum 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xnum 0)) ) (if (= nummern 4) (if (/= pnr "") (if (= xnum 1) (if (= auswahl 4) (setq mitnum 1) (progn (if (= linien 2) (setq mitnum 1)) (if (/= sym "") (if (= einzel 1) (setq mitnum 1)) ) ) ) ) ) ) ; (setq mithoeh 0) (setq xhoeh 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xhoeh 0)) ) (if (= hoehen 8) (if (/= lcode "199") (if (= xhoeh 1) (if (/= zzz 0.0) (if (= auswahl 8) (setq mithoeh 1) (progn (if (= linien 2) (setq mithoeh 1)) (if (/= sym "") (if (= einzel 1) (setq mithoeh 1)) ) ) ) ) ) ) ) ; (setq pkt1 (list xxx yyy zzz)) (setq pkt3 (list xxx yyy)) ; ; ; (if (= mitnum 1) (progn (if (= hset 0) (setq hset 2) (if (= hset 1) (setq hset 3) ) ) (if (/= sym "") (progn (setq numlay "einzelnum") (if (= sym "6") (setq numlay "grenznum")) (if (= sym "7") (setq numlay "grenznum")) (if (= sym "600") (setq numlay "grenznum")) (if (= sym "601") (setq numlay "grenznum")) (if (= (substr sym 1 2) "43") (setq numlay "snum")) (command "-layer" "m" numlay "") ) (progn (command "-layer" "m" "krznum" "" "einfüge" "nkrz" pkt1 fkt "" richt) (setq numlay "sonstnum") (if (= lcode "13") (setq numlay "gebnum")) (if (= lcode "2") (setq numlay "boeschnum")) (if (= lcode "3") (setq numlay "boeschnum")) (if (= lcode "4") (setq numlay "boeschnum")) (if (= lcode "21") (setq numlay "stranum")) (if (= lcode "22") (setq numlay "stranum")) (if (= lcode "23") (setq numlay "stranum")) (if (= lcode "24") (setq numlay "stranum")) (if (= lcode "25") (setq numlay "stranum")) (if (= lcode "26") (setq numlay "stranum")) (if (= lcode "27") (setq numlay "stranum")) (if (= lcode "28") (setq numlay "stranum")) (if (= lcode "6") (setq numlay "grenznum")) (if (= lcode "7") (setq numlay "grenznum")) (if (= lcode "600") (setq numlay "grenznum")) (if (= lcode "601") (setq numlay "grenznum")) (command "-layer" "m" numlay "") ) ) (if (/= sym "99") (progn (setq txp1 (+ xxx (* willxu 1.5))) (setq txp2 (+ yyy (* willyu 1.5))) (setq txp (list txp1 txp2)) (command "text" "p" "ol" txp (* zusch 1.8) richt pnr) ) ) ) ) ; ; (if (= mithoeh 1) (progn (if (= sym "") (progn (command "-layer" "m" (strcat "H" lcode) "") (command "einfüge" "hkrz" pkt1 fkt "" richt) ) (command "-layer" "m" (strcat "H" sym) "") ) (if (= hset 0) (setq hset 1) (if (= hset 2) (setq hset 3) ) ) (setq txp1 (+ xxx (* willxo 1.12))) (setq txp2 (+ yyy (* willyo 1.12))) (setq txp (list txp1 txp2)) (command "text" txp hscala richt (rtos zzz 2 2)) ; ; --> die letzte Ziffer n bei (rtos zzz 2 n) bedeutet die Anzahl der Nachkommastellen ! ; ) ) ; ; (if (= einzel 1) (if (/= sym "") (progn ; ; SYMBOLCODES SETZEN ; (command "-layer" "m" sym "") ; (setq ix 0) ; (if (= sym "1") ; Heizungsschacht (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "hzgs") ) ) ; (if (= sym "6" ) (setsym "grenz1")) ; GRENZPUNKT aufgemessen (if (= sym "7" ) (setsym "grenz2")) ; GRENZPUNKT übernommen (if (= sym "8" ) (setsym "tpkt")) ; TP ; (if (= sym "9") ; FERNMELDESCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "fms") ) ) ; (if (= sym "10") (setsym "nbaum")) ; NADELBAUM (if (= sym "10A") (setsym "nbaum")) ; NADELBAUM (if (= sym "10B") (setsym "nbaum")) ; NADELBAUM (if (= sym "10C") (setsym "nbaum")) ; NADELBAUM (if (= sym "10D") (setsym "nbaum")) ; NADELBAUM (if (= sym "10E") (setsym "nbaum")) ; NADELBAUM (if (= sym "10F") (setsym "nbaum")) ; NADELBAUM (if (= sym "10G") (setsym "nbaum")) ; NADELBAUM (if (= sym "10H") (setsym "nbaum")) ; NADELBAUM (if (= sym "11") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11A") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11B") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11C") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11D") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11E") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11F") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11G") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11H") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11I") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11J") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11K") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11R") (setsym "lbaum")) ; LAUBBAUM (if (= sym "11L") (setsym "lbaum")) ; LAUBBAUM (if (= sym "119") (setsym "stumpf")) ; BAUMSTUMPF (if (= sym "111") (setsym "obaum")) ; OBSTBAUM (if (= sym "12") (setsym "heckp")) ; HECKENPUNKT (if (= sym "121") (setsym "gebue-gm")); GEBÜSCH gemessen (if (= sym "19") (setsym "hfp")) ; HÖHENFESTPUNKT / MB (if (= sym "191") (setsym "MB")) ; HÖHENFESTPUNKT / MB (if (= sym "21") (setsym "fahrbm")) ; FAHRBAHNMITTE (if (= sym "282") (setsym "PFEIL-HR")); PFEIL HALBRECHTS (if (= sym "30") (setsym "verkz1")) ; VERKEHRSZEICHEN (if (= sym "301") (setsym "verkz4")) ; HINWEISSCHILD (if (= sym "302") (setsym "strs")) ; STRASSENNAME (if (= sym "303") (setsym "hst")) ; HALTESTELLE (if (= sym "31") (setsym "verkz2")) ; AMPEL (if (= sym "311") (setsym "sig")) ; SIGNAL (if (= sym "312") (setsym "schranke")); SCHRANKE (if (= sym "313") (setsym "wbake")) ; WARNBAKE (if (= sym "314") (setsym "wkreuz")) ; WARN-/ANDREASKREUZ (if (= sym "321") (setsym "kms1")) ; KILOMETERSTEIN Straße (if (= sym "322") (setsym "kms2")) ; KILOMETERSTEIN Eisenbahn (if (= sym "323") (setsym "station")) ; STATIONSZEICHEN (if (= sym "33") (setsym "verkz3")) ; ORTSDURCHFAHRTSSCHILD (if (= sym "34") (setsym "sohle")) ; BACHSOHLE (if (= sym "35") (setsym "rs")) ; ROHRSOHLE (if (= sym "36") (setsym "fmast")) ; FAHNENMAST ; (if (= sym "37") ; ANSCHLAGSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "ans") ) ) ; (if (= sym "38") ; WASSERSCHACHT rechteckig (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "wscha1") ) ) ; (if (= sym "381") ; WASSERSCHACHT rund (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "wscha2") ) ) ; (if (= sym "39") (setsym "dkm")) ; DENKMAL (if (= sym "40") (setsym "br1")) ; SPRINGBRUNNEN (if (= sym "41") (setsym "ws")) ; WASSERSCHIEBER (if (= sym "411") (setsym "as")) ; ABWASSERSCHIEBER (if (= sym "412") (setsym "has")) ; WASSERSCHIEBER (if (= sym "42") (setsym "hydr1")) ; ÜBERFLURHYDRANT (if (= sym "431") (setsym "schacht1")); ABWASSERSCHACHT rund (if (= sym "432") (setsym "schacht2")); ABWASSERSCHACHT rechteckig (if (= sym "433") (setsym "schacht3")); EINLAUFSCHACHT rund (if (= sym "434") (setsym "schacht4")); EINLAUFSCHACHT rechteckig (if (= sym "435") (setsym "Dscha")) ; DRAINAGESCHACHT (if (= sym "44") (setsym "einl1")) ; EINLAUF (if (= sym "441") (setsym "einl2")) ; STRASSENEINLAUF (if (= sym "442") (setsym "einl3")) ; SEITENEINLAUF (if (= sym "45") (setsym "hydr2")) ; UNTERFLURHYDRANT (if (= sym "50") (setsym "mast1")) ; STAHLGITTERMAST (if (= sym "51") (setsym "mast2")) ; STAHLROHRMAST (if (= sym "52") (setsym "mast3")) ; BETONMAST (if (= sym "53") (setsym "mast4")) ; HOLZMAST (if (= sym "507") (setsym "lmast1")) ; STAHLGITTERM: mit Leuchte (if (= sym "517") (setsym "lmast2")) ; STAHLROHRM: mit Leuchte (if (= sym "527") (setsym "lmast3")) ; BETONM: mit Leuchte (if (= sym "537") (setsym "lmast4")) ; HOLZM: mit Leuchte ; (if (= sym "54") ; KABELSCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "ksch") ) ) ; (if (= sym "541") ; KABELSCHACHT doppelt (progn (if (> symricht 150.0) (if (< symricht 350.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (if (>= symricht 350.0) (setsym "ksch2") (if (<= symricht 50.0) (setsym "ksch2") (setsym "ksch1") ) ) ) ) ; (if (= sym "55") (setsym "kabst")) ; KABELSTEIN ; (if (= sym "551") ; PRELLSTEIN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "prell") ) ) ; (if (= sym "56") ; SCHALTKASTEN (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "schk") ) ) ; (if (= sym "561") ; SCHALTKASTEN / ELT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "elt") ) ) ; (if (= sym "562") ; SCHALTKASTEN / TEL (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-tel") ) ) ; (if (= sym "563") ; SCHALTKASTEN / TV (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-TV") ) ) ; (if (= sym "57") (setsym "lat")) ; LATERNE ; (if (= sym "58") ; RUFSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "rufs") ) ) ; (if (= sym "61") (setsym "planke")) ; LEITPLANKE (if (= sym "64") (setsym "gass")) ; GASSÄULE / MERKSTEIN ; (if (= sym "651") ; PARKUHR (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (+ symricht 200.0))) ) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (setsym "puhr") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "p-autom") ) ) ; (if (= sym "67") (setsym "gwt")) ; GASWASSERTOPF ; (if (= sym "74") ; TRANSFORMATORENHÄUSCHEN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "trafo") ) ) ; (if (= sym "76") (setsym "oel")) ; OELABSCHEIDER (if (= sym "761") (setsym "benzin")) ; BEZINABSCHEIDER ; (if (= sym "79") ; TELEFONZELLE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "tele") ) ) ; (if (= sym "70") (setsym "poll")) ; POLLER (if (= sym "71") (setsym "sohle")) ; SOHLE (if (= sym "80") (setsym "br2")) ; BRUNNEN öffentl. Wasservers. (if (= sym "82") (setsym "okwasser")); WASSERSPIEGEL ; (if (= sym "83") ; BRIEFKASTEN (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "briefk") ) ) ; (if (= sym "84") (setsym "stütze")) ; STÜTZE (if (= sym "89") (setsym "klgr")) ; KLÄRGRUBE (if (= sym "90") (setsym "wass")) ; WASSERSÄULE (if (= sym "901") (setsym "luf")) ; ENTLÜFTUNG (if (= sym "91") (setsym "gs")) ; GASSCHIEBER (if (= sym "921") (setsym "bohr1")) ; KERNBOHRPUNKT (if (= sym "922") (setsym "bohr2")) ; BOHRPUNKT (if (= sym "923") (setsym "bohr3")) ; PEGELBOHRPUNKT (if (= sym "93") (setsym "ok")) ; OBERKANTE (if (= sym "931") (setsym "okfeg")) ; OBERKANTE FUSSBODEN EG (if (= sym "932") (setsym "okfkg")) ; OBERKANTE FUSSBODEN KG (if (= sym "933") (setsym "eg")) ; OBERKANTE EINGANG (if (= sym "934") (setsym "kf")) ; OBERKANTE KELLERFENSTER (if (= sym "94") (setsym "uk")) ; UNTERKANTE (if (= sym "95") (setsym "fallr")) ; FALLROHR (if (= sym "97") (setsym "flmst")) ; FLUTLICHTMAST ; (if (= sym "600") (setq ix 1)) ; GRENZSTEIN SCHWARZ (if (= sym "601") (setq ix 1)) ; GRENZSTEIN ROT ; (if (= sym "602") ; AP (progn (setq xfkt fkt) (setq fkt (* fkt 1.3)) (setsym "grenz2") (setq fkt xfkt) ) ) ; (if (= sym "603") ; AP-SICHERUNG (progn (setq xfkt fkt) (setq fkt (* fkt 1.3)) (setsym "grenz2") (setq fkt xfkt) ) ) ; (if (= sym "991") ; AP (progn (setsym "ap") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "99") ; POLYGONPUNKT (progn (setsym "pp") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ; (if (= ix 0) (progn (setq symricht richt) (setsym "pkt") ) ) ) ) ) ) ) ) ; (setq zi (read-line fi)) ) (close fi) (setq offen 0) ) ) ) ) ) (progn (write-line " Kein Dateiname eingegeben ! ") (write-line "") (graphscr) ) ) ) ) ; ; LIMITEN ANPASSEN ; (setq minx (car (getvar "extmin"))) (setq miny (cadr (getvar "extmin"))) (setq maxx (car (getvar "extmax"))) (setq maxy (cadr (getvar "extmax"))) (setvar "limmin" (list minx miny)) (setvar "limmax" (list maxx maxy)) ; ; L™SCHEN DER ALTEN GITTERKREUZE ; (setq asatz (ssget "X" '((8 . "GITTER")))) (if (/= asatz nil) (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (if (= (cdr (assoc 0 edefi)) "INSERT") (entdel (ssname asatz counter))) (setq counter (1+ counter)) ) (setq asatz nil) ) ) ; ; Setzen der neuen Gitterkreuze ; (if (= rasta 1) (if (> maxx minx) (progn (command "limiten" "aus") (if (= offen 2) (command "-layer" "t" "*" "ei" "*" "") (if (= mitgitter 1) (command "-layer" "t" "gitter" "")) ) ; (setq xuanz (fix (/ (- maxx minx) abst))) (setq yuanz (fix (/ (- maxy miny) abst))) (setq xmi (* abst (fix (/ minx abst)) 1.0)) (setq ymi (* abst (fix (/ miny abst)) 1.0)) ; (setq pt3 (list xmi ymi)) (command "-layer" "m" "gitter" "") (command "einfüge" "krz" pt3 fkt "" "") (command "reihe" (entlast) "" "r" (+ yuanz 2) (+ xuanz 2) abst abst) ) ) ) ; ; Wiederherstellen der Systemvariablen ; (if (= offen 2) (if (= hset 0) (command "-layer" "se" "0" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "*num" "") (command "-layer" "se" "0" "fr" "*num" "fr" "h*" "") ) ) ) ; (if (= hset 0) (command "-layer" "se" "0" "fr" "gitter" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "gitter" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "") (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "fr" "h*" "") ) ) ) ) ; (setq neusetz (getvar "clayer")) (if (/= gesetzt neusetz) (progn (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (= lname gesetzt) (progn (if (= (boole 1 flaggy 1) 1) (command "-layer" "t" lname "")) (command "-layer" "se" lname "") (setq zh nil) ) (setq zh (read-line fh)) ) ) (close fh) ) ) ) ) (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (if (/= zh nil) (progn (command "-layer") (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (/= gesetzt lname) (if (= (boole 1 flaggy 1) 1) (command "fr" lname) (command "t" lname) ) ) (setq zh (read-line fh)) ) (command "") ) ) (close fh) ) ) (command "DEL" "LAYER.TAB") (setvar "REGENMODE" 1) (command "zoom" "a") ; (setvar "dragmode" save05) (setvar "regenmode" save06) (setvar "osmode" save07) (setvar "aunits" save01) (setvar "angbase" save02) (setvar "angdir" save03) (setvar "splinetype" save04) ; (setq rasta nil) (reset_err) ; ) ; ; ; ; ; ; ; ; kart - AutoCAD - Befehl zum Einlesen ; von Linien und Symbolen aus Tachymeteraufnahme ; mit variabler Layerauswahl ; ; neue Code- und Blockdefinitionen (Juni 1994) ; ; Variante mit 3d-Einlesen und alten Bloecken ; (defun C:card3d () ; (init_err) (textscr) (setq hset 0) ; (setq gesetzt (getvar "CLAYER")) (setq fh (open "LAYER.TAB" "w")) (setq mitgitter 0) (if (/= fh nil) (progn (setq edefi2 (tblnext "LAYER" "1")) (while (/= edefi2 nil) (setq lname (cdr (assoc 2 edefi2))) (if (= lname "GITTER") (setq mitgitter 1)) (while (< (strlen lname) 40) (setq lname (strcat lname " "))) (setq lflag (itoa (cdr (assoc 70 edefi2)))) (while (< (strlen lflag) 4) (setq lflag (strcat " " lflag))) (write-line (strcat lname lflag) fh) (setq edefi2 (tblnext "LAYER")) ) (close fh) ) ) ; (write-line "") (setq mst (getint "Maßstab 1 : XXXX <250> : ")) (if (= mst nil) (setq mst 250.0)) (write-line "") (setq abst (fix (/ mst 10))) (setq fkt (/ mst 714.28571)) (setq zusch (/ mst 750.0)) (setq hscala (/ mst 666.6667)) ; ; Sicherung der zu verändernden Systemvariablen ; (setq save01 (getvar "AUNITS")) (setq save02 (getvar "ANGBASE")) (setq save03 (getvar "ANGDIR")) (setq save04 (getvar "SPLINETYPE")) (setq save05 (getvar "DRAGMODE")) (setq save06 (getvar "REGENMODE")) (setq save07 (getvar "OSMODE")) ; ; Setzen der Variablen ; (setvar "AUNITS" 2) (setvar "ANGDIR" 1) (setvar "ANGBASE" (/ pi 2.0)) (setvar "SPLINETYPE" 6) (setvar "CMDECHO" 0) (setvar "DRAGMODE" 0) (setvar "REGENMODE" 0) (setvar "OSMODE" 0) ; (setq richt (getreal "Textrichtung <0> : ")) (if (= richt nil) (setq richt 100.0) (setq richt (- 500.0 richt))) (if (>= richt 400.0) (setq richt (- richt 400.0))) (write-line "") ; ; Berechnung der Verschiebemaße für die Beschriftungen ; (setq willxo (* (sin (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willyo (* (cos (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willxu (* (sin (* (/ (+ richt 12.0) 200.0) pi)) zusch)) (setq willyu (* (cos (* (/ (+ richt 12.0) 200.0) pi)) zusch)) ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 Einzelpunkte ") (write-line " 2 Linien ") (write-line " 4 Punktnummern ") (write-line " 8 Höhen ") (write-line "") (setq auswahl (getint "Ihre Eingabe <3> : ")) (if (= auswahl nil) (setq auswahl 3)) (write-line "") ; (write-line "Bitte wählen Sie aus :") (write-line "") (write-line " 1 mit Raster setzen") (write-line " 2 ohne Raster setzen") (write-line "") (setq rasta (getint "Ihre Eingabe <2> : ")) (write-line "") (IF (/= rasta 2) (setq rasta 2)) ; ; (setq offen 2) (if (/= auswahl 0) (progn (setq einzel (boole 1 auswahl 1)) (setq linien (boole 1 auswahl 2)) (setq nummern (boole 1 auswahl 4)) (setq hoehen (boole 1 auswahl 8)) ; (command "stil" "normal" "romans" "0.0" "1.0" "" "" "" "") (command "farbe" "vonlayer") (setq fnm (getstring "Lesen von Datei : ")) (write-line "") ; (if (/= fnm "") (progn ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line (strcat " Datei " fnm " wurde nicht gefunden ! ")) (write-line "") (graphscr) ) (progn ; ; Einlesen der Linien (Höhenschichtlinien als Polylinie) ; (setq offen 1) (if (= linien 2) (progn (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") (setq polylin 0) (setq altlnum 0) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (if (/= (substr zi 66 3) " 0") (progn ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq lnum (atoi (substr zi 53 4))) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq bog (atoi (substr zi 65 1))) (setq pkt1 (list xxx yyy zzz)) (setq pkt3 (list xxx yyy)) ; ; (if (/= lnum 0) (progn (if (= bog 1) ; BOGENANFANG (setq banfpkt pkt1) ) ; (if (= lnum altlnum) (progn ; (if (< bog 2) (progn (if (= polylin 0) (command "linie" pkt2 pkt1 "") (progn (if (= larc 1) (command "li")) (setq larc 0) (comman pkt3) ) ) ) ) ; (if (>= bog 3) (progn (if (= lcode "199") (progn (setq vfkt (* (distance banfpkt pkt1) 0.5)) (setq symricht (- 400.0 (* (/ (angle banfpkt pkt1) pi) 200.0))) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (command "einfüge" "zaun1" pkt2 vfkt "" symricht) ) (progn (if (= polylin 0) (command "bogen" banfpkt pkt2 pkt1) (progn (if (= larc 0) (command "k")) (command "p" pkt4 pkt3) (setq larc 1) ) ) (if (= bog 4) (setq banfpkt pkt1)) ) ) ) ) ; ) (progn (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) (command "-layer" "m" lcode "") (setq polylin 0) (setq larc 0) (if (= lcode "100") (setq polylin 1)) (if (= lcode "101") (setq polylin 1)) (if (= polylin 1) (command "plinie" pkt3)) ) ) ) ) ; ; (setq altlnum lnum) (setq pkt2 pkt1) (setq pkt4 pkt3) ) ) ) ) (setq zi (read-line fi)) ) (close fi) (setq offen 0) (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) ) ) ; ; Einlesen der Einzelpunkte, Höhen und Nummern ; (if (/= auswahl 2) (progn (if (= offen 0) (progn (setq fi (open fnm "r")) (setq offen 1) ) (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") ) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (setq pnr (substr zi 7 13)) (setq ende 1) (while ende (if (= (substr pnr 1 1) " ") (setq pnr (substr pnr 2 (1- (strlen pnr)))) (setq ende nil) ) ) ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq sym (substr zi 60 3)) (setq ende 1) (while ende (if (= (substr sym 1 1) " ") (setq sym (substr sym 2 (1- (strlen sym)))) (setq ende nil) ) ) ; (if (> (strlen zi) 68) (setq symricht (atof (substr zi 69 10))) (progn (if (= sym "44") (setq symricht 100.0) (setq symricht 0.0)) ) ) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq mitnum 0) (setq xnum 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xnum 0)) ) (if (= nummern 4) (if (/= pnr "") (if (= xnum 1) (if (= auswahl 4) (setq mitnum 1) (progn (if (= linien 2) (setq mitnum 1)) (if (/= sym "") (if (= einzel 1) (setq mitnum 1)) ) ) ) ) ) ) ; (setq mithoeh 0) (setq xhoeh 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xhoeh 0)) ) (if (= hoehen 8) (if (/= lcode "199") (if (= xhoeh 1) (if (/= zzz 0.0) (if (= auswahl 8) (setq mithoeh 1) (progn (if (= linien 2) (setq mithoeh 1)) (if (/= sym "") (if (= einzel 1) (setq mithoeh 1)) ) ) ) ) ) ) ) ; (setq pkt1 (list xxx yyy zzz)) (setq pkt3 (list xxx yyy)) ; ; ; (if (= mitnum 1) (progn (if (= hset 0) (setq hset 2) (if (= hset 1) (setq hset 3) ) ) (if (/= sym "") (progn (setq numlay "einzelnum") (if (= sym "6") (setq numlay "grenznum")) (if (= sym "7") (setq numlay "grenznum")) (if (= sym "600") (setq numlay "grenznum")) (if (= sym "601") (setq numlay "grenznum")) (if (= (substr sym 1 2) "43") (setq numlay "snum")) (command "-layer" "m" numlay "") ) (progn (command "-layer" "m" "krznum" "" "einfüge" "nkrz" pkt1 fkt "" richt) (setq numlay "sonstnum") (if (= lcode "13") (setq numlay "gebnum")) (if (= lcode "2") (setq numlay "boeschnum")) (if (= lcode "3") (setq numlay "boeschnum")) (if (= lcode "4") (setq numlay "boeschnum")) (if (= lcode "21") (setq numlay "stranum")) (if (= lcode "22") (setq numlay "stranum")) (if (= lcode "23") (setq numlay "stranum")) (if (= lcode "24") (setq numlay "stranum")) (if (= lcode "25") (setq numlay "stranum")) (if (= lcode "26") (setq numlay "stranum")) (if (= lcode "27") (setq numlay "stranum")) (if (= lcode "28") (setq numlay "stranum")) (if (= lcode "6") (setq numlay "grenznum")) (if (= lcode "7") (setq numlay "grenznum")) (if (= lcode "600") (setq numlay "grenznum")) (if (= lcode "601") (setq numlay "grenznum")) (command "-layer" "m" numlay "") ) ) (if (/= sym "99") (progn (setq txp1 (+ xxx (* willxu 1.5))) (setq txp2 (+ yyy (* willyu 1.5))) (setq txp (list txp1 txp2)) (command "text" "p" "ol" txp (* zusch 1.8) richt pnr) ) ) ) ) ; ; (if (= mithoeh 1) (progn (if (= sym "") (progn (command "-layer" "m" (strcat "H" lcode) "") (command "einfüge" "pkt" pkt1 fkt "" richt) ) (command "-layer" "m" (strcat "H" sym) "") ) (if (= hset 0) (setq hset 1) (if (= hset 2) (setq hset 3) ) ) (setq txp1 (+ xxx (* willxo 1.12))) (setq txp2 (+ yyy (* willyo 1.12))) (setq txp (list txp1 txp2)) (command "text" txp hscala richt (rtos zzz 2 2)) ; ; --> die letzte Ziffer n bei (rtos zzz 2 n) bedeutet die Anzahl der Nachkommastellen ! ; ) ) ; ; (if (= einzel 1) (if (/= sym "") (progn ; ; SYMBOLCODES SETZEN ; (command "-layer" "m" sym "") ; (setq ix 0) ; (if (= sym "1") ; Heizungsschacht (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB1321") ) ) ; (if (= sym "2") (setsym "SYMB0001")) ; GELÄNDEPUNKT (if (= sym "3") (setsym "SYMB0001")) ; GELÄNDEPUNKT (if (= sym "4") (setsym "SYMB0001")) ; GELÄNDEPUNKT (if (= sym "5") (setsym "SYMB1416")) ; DURCHLASS (if (= sym "6") (setsym "SYMB0002")) ; GRENZPUNKT aufgemessen (if (= sym "7") (setsym "SYMB0566")) ; GRENZPUNKT nicht aufgemessen (if (= sym "7A") (setsym "SYMB0005")) ; GRENZPUNKT übern. Vermbüro (if (= sym "701") (setsym "SYMB0001")) ; GRENZPUNKT nicht abgemarkt (if (= sym "8") ; TP (progn (setsym "SYMB0005") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) (if (= sym "9") (setsym "SYMB1313")) ; FERNMELDESCHACHT ; (if (= sym "10") (setsym "SYMB1124")) ; NADELBAUM (if (= sym "102") (setsym "SYMB1466")) ; FELS (if (= sym "10A") (setsym "SYMB1150")) ; EIBE (if (= sym "10B") (setsym "SYMB1151")) ; FICHTE (if (= sym "10C") (setsym "SYMB1152")) ; KIEFER (if (= sym "10D") (setsym "SYMB1153")) ; LÄRCHE (if (= sym "10E") (setsym "SYMB1154")) ; LEBENSBAUM (if (= sym "10F") (setsym "SYMB1155")) ; TANNE (if (= sym "10G") (setsym "SYMB1156")) ; WACHOLDER (if (= sym "10H") (setsym "SYMB1157")) ; ZYPRESSE (if (= sym "11") (setsym "SYMB1122")) ; LAUBBAUM (if (= sym "111") (setsym "SYMB1123")) ; OBSTBAUM (if (= sym "112") (setsym "SYMB1304")) ; OBSTPLANTAGE (if (= sym "11A") (setsym "SYMB1140")) ; AHORN (if (= sym "11B") (setsym "SYMB1141")) ; BIRKE (if (= sym "11C") (setsym "SYMB1142")) ; BUCHE (if (= sym "11D") (setsym "SYMB1143")) ; EICHE (if (= sym "11E") (setsym "SYMB1144")) ; ESCHE (if (= sym "11F") (setsym "SYMB1145")) ; KASTANIE (if (= sym "11G") (setsym "SYMB1146")) ; LINDE (if (= sym "11H") (setsym "SYMB1147")) ; PAPPEL (if (= sym "11I") (setsym "SYMB1148")) ; WEIDE (if (= sym "11J") (setsym "SYMB1326")) ; LAUBBAUM planerischer Bedeutung ; ; (if (= sym "12") (setsym "heckp")) ; HECKENPUNKT ; (if (= sym "138") (setsym "SYMB1312")) ; TANKSTELLE (if (= sym "15") ; ZAUNSSÄULE (progn (setq xfkt fkt) (setq fkt (* fkt 0.5)) (setsym "SYMB1220") (setq fkt xfkt) ) ) (if (= sym "161") (setsym "SYMB0563")) ; TOR (if (= sym "171") (setsym "SYMB1303")) ; TÜR (if (= sym "182") (setsym "SYMB0606")) ; OK SCHWELLE (if (= sym "183") (setsym "SYMB0001")) ; OK EINGANGSSTUFE (if (= sym "19") (setsym "SYMB1109")) ; HÖHENFESTPUNKT / PB (if (= sym "191") (setsym "SYMB1109")) ; HÖHENFESTPUNKT / MB (if (= sym "20") (setsym "SYMB0031")) ; NETZKNOTENPUNKT (if (= sym "21") (setsym "SYMB0001")) ; FAHRBAHNMITTE (if (= sym "282") (setsym "PFEIL-HR")) ; PFEIL HALBRECHTS (if (= sym "30") (setsym "SYMB1269")) ; VERKEHRSZEICHEN feststehend (if (= sym "301") (setsym "SYMB1302")) ; VERKEHRZEICHENBRÜCKE (if (= sym "302") (setsym "SYMB1269")) ; STRASSENNAMENSCHILD (if (= sym "303") (setsym "SYMB0636")) ; HALTESTELLE Bus+Bahn (if (= sym "304") (setsym "SYMB1300")) ; WERBETAFEL (if (= sym "306") (setsym "SYMB1318")) ; SCHILDERPFAHL (if (= sym "307") (setsym "SYMB1320")) ; LICHTZEICHENBRÜCKE (if (= sym "308") (setsym "SYMB1301")) ; BLINKLICHT/SIGNALZEICHEN (if (= sym "309") (setsym "SYMB1249")) ; WEGWEISER (if (= sym "31") (setsym "SYMB1273")) ; AMPEL (if (= sym "310") (setsym "SYMB1324")) ; WINDRAD (if (= sym "312") (setsym "SYMB0555")) ; SCHRANKE (if (= sym "321") (setsym "SYMB1225")) ; KILOMETERSTEIN Straße (if (= sym "322") (setsym "SYMB1225")) ; KILOMETERSTEIN Eisenbahn (if (= sym "323") (setsym "SYMB1317")) ; STATIONSZEICHEN (if (= sym "324") (setsym "SYMB0592")) ; ORTSDURCHFAHRTSSTEIN (if (= sym "33") (setsym "SYMB1269")) ; ORTSDURCHFAHRTSSCHILD (if (= sym "35") (setsym "SYMB1308")) ; ROHRSOHLE (if (= sym "36") (setsym "SYMB1314")) ; FAHNENMAST ; ; (if (= sym "37") ; ANSCHLAGSÄULE ; (progn ; (while (> symricht 50.0) (setq symricht (- symricht 100.0))) ; (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) ; (setsym "ans") ; ) ; ) ; ; (if (= sym "382") (setsym "rst")) ; ROHRSTUTZEN ; (if (= sym "39") (setsym "SYMB1248")) ; DENKMAL ; (if (= sym "40") (setsym "br1")) ; SPRINGBRUNNEN (if (= sym "41") (setsym "SYMB1119")) ; WASSERSCHIEBER ; (if (= sym "411") (setsym "as")) ; ABWASSERSCHIEBER (if (= sym "42") (setsym "SYMB1247")) ; ÜBERFLURHYDRANT (if (= sym "431") (setsym "SYMB1327")) ; ABWASSERSCHACHT rund (if (= sym "432") (setsym "SYMB1205")) ; ABWASSERSCHACHT rechteckig (if (= sym "433") (setsym "SYMB1093")) ; EINLAUFSCHACHT rund (if (= sym "434") (setsym "SYMB1205")) ; EINLAUFSCHACHT rechteckig (if (= sym "436") (setsym "SYMB1203")) ; LICHTSCHACHT (if (= sym "44") (setsym "SYMB1239")) ; EINLAUF mittig (if (= sym "441") (setsym "SYMB1239")) ; EINLAUF am Rand (if (= sym "442") (setsym "SYMB1239")) ; SEITENEINLAUF (if (= sym "45") (setsym "SYMB1405")) ; UNTERFLURHYDRANT (if (= sym "50") (setsym "SYMB1237")) ; STAHLGITTERMAST (if (= sym "501") (setsym "SYMB1323")) ; FUNKMAST (if (= sym "51") (setsym "SYMB1083")) ; STAHLROHRMAST (if (= sym "52") (setsym "SYMB1080")) ; BETONMAST (if (= sym "53") (setsym "SYMB1077")) ; HOLZMAST (if (= sym "507") (setsym "SYMB1070")) ; STAHLGITTERM: mit Leuchte (if (= sym "517") (setsym "SYMB1070")) ; STAHLROHRM: mit Leuchte (if (= sym "527") (setsym "SYMB1070")) ; BETONM: mit Leuchte (if (= sym "521") (setsym "SYMB1100")) ; DOPPELMAST (if (= sym "531") (setsym "SYMB0550")) ; A-MAST (if (= sym "537") (setsym "SYMB1070")) ; HOLZM: mit Leuchte ; (if (= sym "54") ; KABELSCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB1233") ) ) (if (= sym "541") ; KABELSCHACHT doppelt (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB1218") ) ) ; ; (if (= sym "542") (setsym "kbm")) ; KABELMUFFE ; (if (= sym "55") ; MERKZEICHEN Elt (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0556") ) ) (if (= sym "552") ; MERKZEICHEN Post (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0558") ) ) (if (= sym "553") ; MERKZEICHEN Fernwärme (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0559") ) ) (if (= sym "56") (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0565") ; SCHALTKASTEN ) ) (if (= sym "561") (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0565") ; SCHALTKASTEN ) ) (if (= sym "57") (setsym "SYMB1070")) ; LATERNE (if (= sym "571") (setsym "SYMB1270")) ; GASLATERNE ; ; (if (= sym "58") (setsym "SYMB0711")) ; RUFSÄULE ; (progn ; (while (> symricht 50.0) (setq symricht (- symricht 100.0))) ; (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) ; (setsym "rufs") ; ) ; ) ; ; (if (= sym "595") (setsym "ltg")) ; UK Elektroleitung ; (if (= sym "596") (setsym "fd")) ; UF Fahrdraht ; (if (= sym "60") (setsym "SYMB0011")) ; LEITUNGSPUNKT Freiltg. Strom (if (= sym "601") (setsym "SYMB0011")) ; LEITUNGSPUNKT Freiltg. FM ; (if (= sym "61") (setsym "planke")) ; LEITPLANKE ; (if (= sym "622") (setsym "spf1")) ; SPERRPFOSTEN ; (if (= sym "623") (setsym "spf2")) ; HšLSE FšR SPERRPFOSTEN (if (= sym "64") (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0557") ; MERKSÄULE Gas ) ) ; (if (= sym "65") (setsym "SYMB1309")) ; PARKPLATZ ; (if (= sym "651") (setsym "SYMB1319")) ; PARKUHR (if (= sym "702") (setsym "SYMB1077")) ; GRENZPUNKT übernommen (if (= sym "703") (setsym "SYMB0569")) ; GRENZPUNKT nicht aktuell (if (= sym "71") (setsym "SYMB0001")) ; SOHLE (if (= sym "74") (setsym "SYMB1412")) ; TRANSFORMATORENHÄUSCHEN ; (if (= sym "76") (setsym "oel")) ; OELABSCHEIDER ; (if (= sym "774") (setsym "SYMB0001")) ; PFEILER Achse (if (= sym "775") (setsym "SYMB0001")) ; Pfeiler Ecke (if (= sym "776") (setsym "SYMB1328")) ; LICHTE HÖHE (if (= sym "79") (setsym "SYMB1311")) ; TELEFONZELLE (if (= sym "80") (setsym "SYMB0553")) ; BRUNNEN (if (= sym "801") (setsym "SYMB0552")) ; QUELLE (if (= sym "802") (setsym "SYMB0554")) ; PUMPE (if (= sym "82") (setsym "SYMB1415")) ; WASSERSPIEGEL (if (= sym "871") (setsym "SYMB1005")) ; LAUBWALD (if (= sym "872") (setsym "SYMB1010")) ; NADELWALD (if (= sym "873") (setsym "SYMB1011")) ; MISCHWALD (if (= sym "874") (setsym "SYMB1256")) ; GEBÜSCH ; (if (= sym "89") (setsym "klgr")) ; KLŽRGRUBE (if (= sym "90") (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0568") ; MERKSÄULE Wasser ) ) ; (if (= sym "901") (setsym "luf")) ; ENTLÜFTUNG (if (= sym "91") (setsym "SYMB1117")) ; GASSCHIEBER ; (if (= sym "921") (setsym "bohr1")) ; KERNBOHRPUNKT ; (if (= sym "922") (setsym "bohr2")) ; BOHRPUNKT (if (= sym "923") (setsym "SYMB1310")) ; PEGELBOHRPUNKT ; (if (= sym "923") (setsym "bohr3")) ; PEGELBOHRPUNKT ; (if (= sym "93") (setsym "ok")) ; OBERKANTE ; (if (= sym "931") (setsym "okfeg")) ; OBERKANTE FB EG ; (if (= sym "932") (setsym "okfkg")) ; OBERKANTE FB KG ; (if (= sym "94") (setsym "uk")) ; UNTERKANTE (if (= sym "95") (setsym "SYMB0063")) ; FALLROHR ; (if (= sym "97") (setsym "flmst")) ; FLUTLICHTMAST (if (= sym "98") (setsym "SYMB0001")) ; GELÄNDEPUNKT (if (= sym "980") (setsym "SYMB1305")) ; ACKER (if (= sym "981") (setsym "SYMB1036")) ; WIESE (if (= sym "982") (setsym "SYMB1015")) ; MOOR (if (= sym "983") (setsym "SYMB1016")) ; SCHILF (if (= sym "984") (setsym "SYMB1012")) ; PARKANLAGE (if (= sym "985") (setsym "SYMB1306")) ; GARTENANLAGE (if (= sym "986") (setsym "SYMB1435")) ; CAMPINGPLATZ ; (if (= sym "984") (setsym "SYMB0001")) ; UK Brücke (Durchfahrtsh"he) ; (if (= sym "985") (setsym "SYMB0007")) ; Blumenkübel 1.0 x 1.0 ; ; (if (= sym "991") ; AP (progn (setsym "SYMB0002") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "99") ; POLYGONPUNKT (progn (setsym "SYMB0002") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= ix 0) (progn (setq symricht richt) (setsym "SYMB0011") ) ) ) ) ) ) ) ; (setq zi (read-line fi)) ) (close fi) (setq offen 0) ) ) ) ) ) (progn (write-line " Kein Dateiname eingegeben ! ") (write-line "") (graphscr) ) ) ) ) ; ; LIMITEN ANPASSEN ; (setq minx (car (getvar "extmin"))) (setq miny (cadr (getvar "extmin"))) (setq maxx (car (getvar "extmax"))) (setq maxy (cadr (getvar "extmax"))) (setvar "limmin" (list minx miny)) (setvar "limmax" (list maxx maxy)) ; ; L™SCHEN DER ALTEN GITTERKREUZE ; (setq asatz (ssget "X" '((8 . "GITTER")))) (if (/= asatz nil) (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (if (= (cdr (assoc 0 edefi)) "INSERT") (entdel (ssname asatz counter))) (setq counter (1+ counter)) ) (setq asatz nil) ) ) ; ; Setzen der neuen Gitterkreuze ; (if (= rasta 1) (if (> maxx minx) (progn (command "limiten" "aus") (if (= offen 2) (command "-layer" "t" "*" "ei" "*" "") (if (= mitgitter 1) (command "-layer" "t" "gitter" "")) ) ; (setq xuanz (fix (/ (- maxx minx) abst))) (setq yuanz (fix (/ (- maxy miny) abst))) (setq xmi (* abst (fix (/ minx abst)) 1.0)) (setq ymi (* abst (fix (/ miny abst)) 1.0)) ; (setq pt3 (list xmi ymi)) (command "-layer" "m" "gitter" "") (command "einfüge" "krz" pt3 fkt "" "") (command "reihe" (entlast) "" "r" (+ yuanz 2) (+ xuanz 2) abst abst) ) ) ) ; ; Wiederherstellen der Systemvariablen ; (if (= offen 2) (if (= hset 0) (command "-layer" "se" "0" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "*num" "") (command "-layer" "se" "0" "fr" "*num" "fr" "h*" "") ) ) ) ; (if (= hset 0) (command "-layer" "se" "0" "fr" "gitter" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "gitter" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "") (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "fr" "h*" "") ) ) ) ) ; (setq neusetz (getvar "clayer")) (if (/= gesetzt neusetz) (progn (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (= lname gesetzt) (progn (if (= (boole 1 flaggy 1) 1) (command "-layer" "t" lname "")) (command "-layer" "se" lname "") (setq zh nil) ) (setq zh (read-line fh)) ) ) (close fh) ) ) ) ) (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (if (/= zh nil) (progn (command "-layer") (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (/= gesetzt lname) (if (= (boole 1 flaggy 1) 1) (command "fr" lname) (command "t" lname) ) ) (setq zh (read-line fh)) ) (command "") ) ) (close fh) ) ) (command "DEL" "LAYER.TAB") (setvar "REGENMODE" 1) (command "zoom" "a") ; (setvar "dragmode" save05) (setvar "regenmode" save06) (setvar "osmode" save07) (setvar "aunits" save01) (setvar "angbase" save02) (setvar "angdir" save03) (setvar "splinetype" save04) ; (setq rasta nil) (reset_err) ; ) ; ; ; ; ; kart - AutoCAD - Befehl zum Einlesen ; von Linien und Symbolen aus Tachymeteraufnahme ; mit variabler Layerauswahl ; ; ; Variante 2d-Einlesen mit Bögen ; (defun C:polykart () ; (init_err) (textscr) (setq hset 0) (setq ipl 0) ; (setq gesetzt (getvar "CLAYER")) (setq fh (open "LAYER.TAB" "w")) (setq mitgitter 0) (if (/= fh nil) (progn (setq edefi2 (tblnext "LAYER" "1")) (while (/= edefi2 nil) (setq lname (cdr (assoc 2 edefi2))) (if (= lname "GITTER") (setq mitgitter 1)) (while (< (strlen lname) 40) (setq lname (strcat lname " "))) (setq lflag (itoa (cdr (assoc 70 edefi2)))) (while (< (strlen lflag) 4) (setq lflag (strcat " " lflag))) (write-line (strcat lname lflag) fh) (setq edefi2 (tblnext "LAYER")) ) (close fh) ) ) ; (write-line "") (setq mst (getint "Maßstab 1 : XXXX <250> : ")) (if (= mst nil) (setq mst 250.0)) (write-line "") (setq abst (fix (/ mst 10))) (setq fkt (/ mst 714.28571)) (setq zusch (/ mst 750.0)) (setq hscala (/ mst 666.6667)) ; ; Sicherung der zu verändernden Systemvariablen ; (setq save01 (getvar "AUNITS")) (setq save02 (getvar "ANGBASE")) (setq save03 (getvar "ANGDIR")) (setq save04 (getvar "SPLINETYPE")) (setq save05 (getvar "DRAGMODE")) (setq save06 (getvar "REGENMODE")) (setq save07 (getvar "OSMODE")) ; ; Setzen der Variablen ; (setvar "AUNITS" 2) (setvar "ANGDIR" 1) (setvar "ANGBASE" (/ pi 2.0)) (setvar "SPLINETYPE" 6) (setvar "CMDECHO" 0) (setvar "DRAGMODE" 0) (setvar "REGENMODE" 0) (setvar "OSMODE" 0) ; (setq richt (getreal "Textrichtung <0> : ")) (if (= richt nil) (setq richt 100.0) (setq richt (- 500.0 richt))) (if (>= richt 400.0) (setq richt (- richt 400.0))) (write-line "") ; ; Berechnung der Verschiebemaße für die Beschriftungen ; (setq willxo (* (sin (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willyo (* (cos (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willxu (* (sin (* (/ (+ richt 12.0) 200.0) pi)) zusch)) (setq willyu (* (cos (* (/ (+ richt 12.0) 200.0) pi)) zusch)) ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 Einzelpunkte ") (write-line " 2 Linien ") (write-line " 4 Punktnummern ") (write-line " 8 Höhen ") (write-line "") (setq auswahl (getint "Ihre Eingabe <3> : ")) (if (= auswahl nil) (setq auswahl 3)) (write-line "") ; (write-line "Bitte wählen Sie aus :") (write-line "") (write-line " 1 mit Raster setzen") (write-line " 2 ohne Raster setzen") (write-line "") (setq rasta (getint "Ihre Eingabe <2> : ")) (write-line "") (IF (/= rasta 2) (setq rasta 2)) ; ; (setq offen 2) (if (/= auswahl 0) (progn (setq einzel (boole 1 auswahl 1)) (setq linien (boole 1 auswahl 2)) (setq nummern (boole 1 auswahl 4)) (setq hoehen (boole 1 auswahl 8)) ; (command "stil" "normal" "romans" "0.0" "1.0" "" "" "" "") (command "farbe" "vonlayer") (setq fnm (getstring "Lesen von Datei : ")) (write-line "") ; (if (/= fnm "") (progn ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line (strcat " Datei " fnm " wurde nicht gefunden ! ")) (write-line "") (graphscr) ) (progn ; ; Einlesen der Linien als Polylinien ; (setq offen 1) (if (= linien 2) (progn (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") (setq polylin 1) (setq altlnum 0) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (if (/= (substr zi 66 3) " 0") (progn ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq lnum (atoi (substr zi 53 4))) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq bog (atoi (substr zi 65 1))) (setq pkt1 (list xxx yyy)) ; ; (if (/= lnum 0) (progn (if (= bog 1) ; BOGENANFANG (setq banfpkt pkt1) ) ; (if (= lnum altlnum) (progn ; (if (< bog 2) (progn (if (= larc 1) (command "li")) (setq larc 0) (command pkt1) ) ) ; (if (>= bog 3) (progn (if (= lcode "199") (progn (setq vfkt (* (distance banfpkt pkt1) 0.5)) (setq symricht (- 400.0 (* (/ (angle banfpkt pkt1) pi) 200.0))) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (command "einfüge" "zaun1" pkt2 vfkt "" symricht) ) (progn (if (= larc 0) (command "k")) (command "p" pkt2 pkt1) (setq larc 1) (if (= bog 4) (setq banfpkt pkt1)) ) ) ) ) ; ) (progn (if (= ipl 1)(command "")) (setq ipl 0) (command "-layer" "m" lcode "") (setq larc 0) (if (/= lcode "199") (progn (command "plinie" pkt1) (setq ipl 1) ) ) ) ) ) ) ; ; (setq altlnum lnum) (setq pkt2 pkt1) ) ) ) ) (setq zi (read-line fi)) ) (close fi) (setq offen 0) (if (= ipl 1)(command "")) ) ) ; ; Einlesen der Einzelpunkte, Höhen und Nummern ; (if (/= auswahl 2) (progn (if (= offen 0) (progn (setq fi (open fnm "r")) (setq offen 1) ) (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") ) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (setq pnr (substr zi 7 13)) (setq ende 1) (while ende (if (= (substr pnr 1 1) " ") (setq pnr (substr pnr 2 (1- (strlen pnr)))) (setq ende nil) ) ) ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq sym (substr zi 60 3)) (setq ende 1) (while ende (if (= (substr sym 1 1) " ") (setq sym (substr sym 2 (1- (strlen sym)))) (setq ende nil) ) ) ; (if (> (strlen zi) 68) (setq symricht (atof (substr zi 69 10))) (setq symricht 0.0) ) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq mitnum 0) (setq xnum 1) (if (= (strlen pnr) 5) (if (= lcode "18") (if (= (substr pnr 1 1) "6") (setq xnum 0)) ) ) (if (= nummern 4) (if (/= pnr "") (if (= xnum 1) (if (= auswahl 4) (setq mitnum 1) (progn (if (= linien 2) (setq mitnum 1)) (if (/= sym "") (if (= einzel 1) (setq mitnum 1)) ) ) ) ) ) ) ; (setq mithoeh 0) (setq xhoeh 1) (if (= (strlen pnr) 5) (if (= lcode "18") (if (= (substr pnr 1 1) "6") (setq xhoeh 0)) ) ) (if (= hoehen 8) (if (/= lcode "199") (if (= xhoeh 1) (if (/= zzz 0.0) (if (= auswahl 8) (setq mithoeh 1) (progn (if (= linien 2) (setq mithoeh 1)) (if (/= sym "") (if (= einzel 1) (setq mithoeh 1)) ) ) ) ) ) ) ) ; (setq pkt1 (list xxx yyy)) ; ; ; (if (= mitnum 1) (progn (if (= hset 0) (setq hset 2) (if (= hset 1) (setq hset 3) ) ) (if (/= sym "") (progn (setq numlay "einzelnum") (if (= sym "6") (setq numlay "grenznum")) (if (= sym "7") (setq numlay "grenznum")) (if (= sym "600") (setq numlay "grenznum")) (if (= sym "601") (setq numlay "grenznum")) (if (= (substr sym 1 2) "43") (setq numlay "snum")) (command "-layer" "m" numlay "") ) (progn (command "-layer" "m" "krznum" "" "einfüge" "nkrz" pkt1 fkt "" richt) (setq numlay "sonstnum") (if (= lcode "13") (setq numlay "gebnum")) (if (= lcode "2") (setq numlay "boeschnum")) (if (= lcode "3") (setq numlay "boeschnum")) (if (= lcode "4") (setq numlay "boeschnum")) (if (= lcode "21") (setq numlay "stranum")) (if (= lcode "22") (setq numlay "stranum")) (if (= lcode "23") (setq numlay "stranum")) (if (= lcode "24") (setq numlay "stranum")) (if (= lcode "25") (setq numlay "stranum")) (if (= lcode "26") (setq numlay "stranum")) (if (= lcode "27") (setq numlay "stranum")) (if (= lcode "28") (setq numlay "stranum")) (if (= lcode "6") (setq numlay "grenznum")) (if (= lcode "7") (setq numlay "grenznum")) (if (= lcode "600") (setq numlay "grenznum")) (if (= lcode "601") (setq numlay "grenznum")) (command "-layer" "m" numlay "") ) ) (if (and (/= sym "99") (/= sym "991") (/= sym "8")) (progn (setq txp1 (+ xxx (* willxu 1.5))) (setq txp2 (+ yyy (* willyu 1.5))) (setq txp (list txp1 txp2)) (command "text" "p" "ol" txp (* zusch 1.8) richt pnr) ) ) ) ) ; ; (if (= mithoeh 1) (progn (if (= sym "") (progn (command "-layer" "m" (strcat "H" lcode) "") (command "einfüge" "hkrz" pkt1 fkt "" richt) ) (command "-layer" "m" (strcat "H" sym) "") ) (if (= hset 0) (setq hset 1) (if (= hset 2) (setq hset 3) ) ) (setq txp1 (+ xxx (* willxo 1.12))) (setq txp2 (+ yyy (* willyo 1.12))) (setq txp (list txp1 txp2)) (command "text" txp hscala richt (rtos zzz 2 2)) ; ; --> die letzte Ziffer n bei (rtos zzz 2 n) bedeutet die Anzahl der Nachkommastellen ! ; ) ) ; ; (if (= einzel 1) (if (/= sym "") (progn ; ; SYMBOLCODES SETZEN ; (command "-layer" "m" sym "") ; (setq ix 0) ; (if (= sym "1") ; Heizungsschacht (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "hzgs") ) ) ; (if (= sym "6" ) (setsym "grenz1")) ; GRENZPUNKT aufgemessen (if (= sym "7" ) (setsym "grenz2")) ; GRENZPUNKT übernommen (if (= sym "701" ) (setsym "grenz3")) ; GRENZPUNKT nicht abgemarkt ; (if (= sym "8") ; TP (progn (setsym "tpkt") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "9") ; FERNMELDESCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "fms") ) ) ; (if (= sym "10") (setsym "nbaum")) ; NADELBAUM (if (= sym "11") (setsym "lbaum")) ; LAUBBAUM (if (= sym "119") (setsym "stumpf")) ; BAUMSTUMPF (if (= sym "111") (setsym "obaum")) ; OBSTBAUM (if (= sym "12") (setsym "heckp")) ; HECKENPUNKT (if (= sym "121") (setsym "gebue-gm")); GEBÜSCH gemessen (if (= sym "19") (setsym "hfp")) ; HÖHENFESTPUNKT / MB (if (= sym "191") (setsym "MB")) ; HÖHENFESTPUNKT / MB (if (= sym "21") (setsym "fahrbm")) ; FAHRBAHNMITTE (if (= sym "282") (setsym "PFEIL-HR")); PFEIL HALBRECHTS (if (= sym "30") (setsym "verkz1")) ; VERKEHRSZEICHEN (if (= sym "301") (setsym "verkz4")) ; HINWEISSCHILD (if (= sym "302") (setsym "strs")) ; STRASSENNAME (if (= sym "303") (setsym "hst")) ; HALTESTELLE (if (= sym "31") (setsym "verkz2")) ; AMPEL (if (= sym "311") (setsym "sig")) ; SIGNAL (if (= sym "312") (setsym "schranke")); SCHRANKE (if (= sym "313") (setsym "wbake")) ; WARNBAKE (if (= sym "314") (setsym "wkreuz")) ; WARN-/ANDREASKREUZ (if (= sym "321") (setsym "kms1")) ; KILOMETERSTEIN Straße (if (= sym "322") (setsym "kms2")) ; KILOMETERSTEIN Eisenbahn (if (= sym "323") (setsym "station")) ; STATIONSZEICHEN (if (= sym "33") (setsym "verkz3")) ; ORTSDURCHFAHRTSSCHILD (if (= sym "35") (setsym "rs")) ; ROHRSOHLE (if (= sym "36") (setsym "fmast")) ; FAHNENMAST ; (if (= sym "37") ; ANSCHLAGSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "ans") ) ) ; (if (= sym "38") ; WASSERSCHACHT rechteckig (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "wscha1") ) ) ; (if (= sym "381") ; WASSERSCHACHT rund (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "wscha2") ) ) ; (if (= sym "382") (setsym "rst")) ; ROHRSTUTZEN ; (if (= sym "39") (setsym "dkm")) ; DENKMAL (if (= sym "40") (setsym "br1")) ; SPRINGBRUNNEN (if (= sym "41") (setsym "ws")) ; WASSERSCHIEBER (if (= sym "411") (setsym "as")) ; ABWASSERSCHIEBER (if (= sym "412") (setsym "has")) ; HAUSANSCHLUSSSCHIEBER (if (= sym "413") (setsym "bl-ha")) ; HAUSANSCHLUáSCHIEBER (if (= sym "42") (setsym "hydr1")) ; ÜBERFLURHYDRANT (if (= sym "431") (setsym "schacht1")); ABWASSERSCHACHT rund (if (= sym "432") (setsym "schacht2")); ABWASSERSCHACHT rechteckig (if (= sym "433") (setsym "schacht3")); EINLAUFSCHACHT rund (if (= sym "434") (setsym "schacht4")); EINLAUFSCHACHT rechteckig (if (= sym "435") (setsym "Dscha")) ; DRAINAGESCHACHT (if (= sym "44") (setsym "einl1")) ; EINLAUF (if (= sym "441") (setsym "einl2")) ; STRASSENEINLAUF (if (= sym "442") (setsym "einl3")) ; SEITENEINLAUF (if (= sym "45") (setsym "hydr2")) ; UNTERFLURHYDRANT (if (= sym "50") (setsym "mast1")) ; STAHLGITTERMAST (if (= sym "51") (setsym "mast2")) ; STAHLROHRMAST (if (= sym "52") (setsym "mast3")) ; BETONMAST (if (= sym "53") (setsym "mast4")) ; HOLZMAST (if (= sym "507") (setsym "lmast1")) ; STAHLGITTERMAST mit Leuchte (if (= sym "517") (setsym "lmast2")) ; STAHLROHRMAST mit Leuchte (if (= sym "527") (setsym "lmast3")) ; BETONMAST mit Leuchte (if (= sym "537") (setsym "lmast4")) ; HOLZMAST mit Leuchte ; (if (= sym "54") ; KABELSCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "ksch") ) ) ; (if (= sym "541") ; KABELSCHACHT doppelt (progn (if (> symricht 150.0) (if (< symricht 350.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (if (>= symricht 350.0) (setsym "ksch2") (if (<= symricht 50.0) (setsym "ksch2") (setsym "ksch1") ) ) ) ) ; (if (= sym "542") (setsym "k-lsa")) ; KABELSCHACHT LSA ; (if (= sym "55") (setsym "kabst")) ; KABELSTEIN ; (if (= sym "551") ; PRELLSTEIN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "prell") ) ) ; (if (= sym "56") ; SCHALTKASTEN (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "schk") ) ) ; (if (= sym "561") ; SCHALTKASTEN / ELT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "elt") ) ) ; (if (= sym "562") ; SCHALTKASTEN / TEL (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-tel") ) ) ; (if (= sym "563") ; SCHALTKASTEN / TV (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-TV") ) ) ; (if (= sym "57") (setsym "lat")) ; LATERNE (if (= sym "571") (setsym "scheinw")) ; SCHEINWERFER ; (if (= sym "58") ; RUFSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "rufs") ) ) ; (if (= sym "595") (setsym "ltg")) ; UK Elektroleitung (if (= sym "596") (setsym "fd")) ; UF Fahrdraht ; (if (= sym "61") (setsym "planke")) ; LEITPLANKE (if (= sym "622") (setsym "spf1")) ; SPERRPFOSTEN (if (= sym "623") (setsym "spf2")) ; HšLSE FšR SPERRPFOSTEN (if (= sym "64") (setsym "gass")) ; GASSÄULE / MERKSTEIN ; (if (= sym "651") ; PARKUHR (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (+ symricht 200.0))) ) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (setsym "puhr") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "p-autom") ) ) ; (if (= sym "67") (setsym "gwt")) ; GASWASSERTOPF ; (if (= sym "74") ; TRANSFORMATORENHÄUSCHEN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "trafo") ) ) ; (if (= sym "76") (setsym "oel")) ; OELABSCHEIDER (if (= sym "761") (setsym "benzin")) ; BEZINABSCHEIDER ; (if (= sym "79") ; TELEFONZELLE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "tele") ) ) ; (if (= sym "70") (setsym "poll")) ; POLLER (if (= sym "80") (setsym "br2")) ; BRUNNEN öffentl. Wasservers. ; (if (= sym "83") ; BRIEFKASTEN (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "briefk") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "p-autom") ) ) ; (if (= sym "84") (setsym "stütze")) ; STÜTZE (if (= sym "89") (setsym "klgr")) ; KLÄRGRUBE rund (if (= sym "891") (setsym "klgr1")) ; KLÄRGRUBE variabel (if (= sym "90") (setsym "wass")) ; WASSERSÄULE (if (= sym "901") (setsym "luf")) ; ENTLÜFTUNG (if (= sym "91") (setsym "gs")) ; GASSCHIEBER (if (= sym "921") (setsym "bohr1")) ; KERNBOHRPUNKT (if (= sym "922") (setsym "bohr2")) ; BOHRPUNKT (if (= sym "923") (setsym "bohr3")) ; PEGELBOHRPUNKT (if (= sym "93") (setsym "ok")) ; OBERKANTE (if (= sym "931") (setsym "okfeg")) ; OBERKANTE FB EG (if (= sym "932") (setsym "okfkg")) ; OBERKANTE FB KG (if (= sym "94") (setsym "uk")) ; UNTERKANTE (if (= sym "95") (setsym "fallr")) ; FALLROHR (if (= sym "97") (setsym "flmst")) ; FLUTLICHTMAST ; (if (= sym "99") ; POLYGONPUNKT (progn (setsym "pp") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "991") ; AP (progn (setsym "ap") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= ix 0) (progn (setq symricht richt) (setsym "pkt") ) ) ) ) ) ) ) ; (setq zi (read-line fi)) ) (close fi) (setq offen 0) ) ) ) ) ) (progn (write-line " Kein Dateiname eingegeben ! ") (write-line "") (graphscr) ) ) ) ) ; ; LIMITEN ANPASSEN ; (setq minx (car (getvar "extmin"))) (setq miny (cadr (getvar "extmin"))) (setq maxx (car (getvar "extmax"))) (setq maxy (cadr (getvar "extmax"))) (setvar "limmin" (list minx miny)) (setvar "limmax" (list maxx maxy)) ; ; L™SCHEN DER ALTEN GITTERKREUZE ; (setq asatz (ssget "X" '((8 . "GITTER")))) (if (/= asatz nil) (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (if (= (cdr (assoc 0 edefi)) "INSERT") (entdel (ssname asatz counter))) (setq counter (1+ counter)) ) (setq asatz nil) ) ) ; ; Setzen der neuen Gitterkreuze ; (if (= rasta 1) (if (> maxx minx) (progn (command "limiten" "aus") (if (= offen 2) (command "-layer" "t" "*" "ei" "*" "") (if (= mitgitter 1) (command "-layer" "t" "gitter" "")) ) ; (setq xuanz (fix (/ (- maxx minx) abst))) (setq yuanz (fix (/ (- maxy miny) abst))) (setq xmi (* abst (fix (/ minx abst)) 1.0)) (setq ymi (* abst (fix (/ miny abst)) 1.0)) ; (setq pt3 (list xmi ymi)) (command "-layer" "m" "gitter" "") (command "einfüge" "krz" pt3 fkt "" "") (command "reihe" (entlast) "" "r" (+ yuanz 2) (+ xuanz 2) abst abst) ) ) ) ; ; Wiederherstellen der Systemvariablen ; (if (= offen 2) (if (= hset 0) (command "-layer" "se" "0" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "*num" "") (command "-layer" "se" "0" "fr" "*num" "fr" "h*" "") ) ) ) ; (if (= hset 0) (command "-layer" "se" "0" "fr" "gitter" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "gitter" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "") (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "fr" "h*" "") ) ) ) ) ; (setq neusetz (getvar "clayer")) (if (/= gesetzt neusetz) (progn (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (= lname gesetzt) (progn (if (= (boole 1 flaggy 1) 1) (command "-layer" "t" lname "")) (command "-layer" "se" lname "") (setq zh nil) ) (setq zh (read-line fh)) ) ) (close fh) ) ) ) ) (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (if (/= zh nil) (progn (command "-layer") (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (/= gesetzt lname) (if (= (boole 1 flaggy 1) 1) (command "fr" lname) (command "t" lname) ) ) (setq zh (read-line fh)) ) (command "") ) ) (close fh) ) ) (command "DEL" "LAYER.TAB") (setvar "REGENMODE" 1) (command "zoom" "a") ; (setvar "dragmode" save05) (setvar "regenmode" save06) (setvar "osmode" save07) (setvar "aunits" save01) (setvar "angbase" save02) (setvar "angdir" save03) (setvar "splinetype" save04) ; (setq rasta nil) (reset_err) ; ) ; ; ; ; ; Variante Polylinien 3d (mit Höhen) ; (defun C:3dpolykart () ; (init_err) (textscr) (setq hset 0) (setq ipl 0) ; (setq gesetzt (getvar "CLAYER")) (setq fh (open "LAYER.TAB" "w")) (setq mitgitter 0) (if (/= fh nil) (progn (setq edefi2 (tblnext "LAYER" "1")) (while (/= edefi2 nil) (setq lname (cdr (assoc 2 edefi2))) (if (= lname "GITTER") (setq mitgitter 1)) (while (< (strlen lname) 40) (setq lname (strcat lname " "))) (setq lflag (itoa (cdr (assoc 70 edefi2)))) (while (< (strlen lflag) 4) (setq lflag (strcat " " lflag))) (write-line (strcat lname lflag) fh) (setq edefi2 (tblnext "LAYER")) ) (close fh) ) ) ; (write-line "") (setq mst (getint "Maßstab 1 : XXXX <500> : ")) (if (= mst nil) (setq mst 500.0)) (write-line "") (setq abst (fix (/ mst 10))) (setq fkt (/ mst 714.28571)) (setq zusch (/ mst 750.0)) (setq hscala (/ mst 666.6667)) ; ; Sicherung der zu verändernden Systemvariablen ; (setq save01 (getvar "AUNITS")) (setq save02 (getvar "ANGBASE")) (setq save03 (getvar "ANGDIR")) (setq save04 (getvar "SPLINETYPE")) (setq save05 (getvar "DRAGMODE")) (setq save06 (getvar "REGENMODE")) (setq save07 (getvar "OSMODE")) ; ; Setzen der Variablen ; (setvar "AUNITS" 2) (setvar "ANGDIR" 1) (setvar "ANGBASE" (/ pi 2.0)) (setvar "SPLINETYPE" 6) (setvar "CMDECHO" 0) (setvar "DRAGMODE" 0) (setvar "REGENMODE" 0) (setvar "OSMODE" 0) ; (setq richt (getreal "Textrichtung <0> : ")) (if (= richt nil) (setq richt 100.0) (setq richt (- 500.0 richt))) (if (>= richt 400.0) (setq richt (- richt 400.0))) (write-line "") ; ; Berechnung der Verschiebemaße für die Beschriftungen ; (setq willxo (* (sin (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willyo (* (cos (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willxu (* (sin (* (/ (+ richt 12.0) 200.0) pi)) zusch)) (setq willyu (* (cos (* (/ (+ richt 12.0) 200.0) pi)) zusch)) ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 Einzelpunkte ") (write-line " 2 Linien ") (write-line " 4 Punktnummern ") (write-line " 8 Höhen ") (write-line "") (setq auswahl (getint "Ihre Eingabe <15> : ")) (if (= auswahl nil) (setq auswahl 15)) (write-line "") ; (write-line "Bitte wählen Sie aus :") (write-line "") (write-line " 1 mit Raster setzen") (write-line " 2 ohne Raster setzen") (write-line "") (setq rasta (getint "Ihre Eingabe <1> : ")) (write-line "") (IF (/= rasta 2) (setq rasta 1)) ; ; (setq offen 2) (if (/= auswahl 0) (progn (setq einzel (boole 1 auswahl 1)) (setq linien (boole 1 auswahl 2)) (setq nummern (boole 1 auswahl 4)) (setq hoehen (boole 1 auswahl 8)) ; (command "stil" "normal" "romans" "0.0" "1.0" "" "" "" "") (command "farbe" "vonlayer") (setq fnm (getstring "Lesen von Datei : ")) (write-line "") ; (if (/= fnm "") (progn ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line (strcat " Datei " fnm " wurde nicht gefunden ! ")) (write-line "") (graphscr) ) (progn ; ; Einlesen der Linien als Polylinien ; (setq offen 1) (if (= linien 2) (progn (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") (setq polylin 1) (setq altlnum 0) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (if (/= (substr zi 66 3) " 0") (progn ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq lnum (atoi (substr zi 53 4))) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq bog (atoi " ")) (setq pkt1 (list xxx yyy zzz)) ; (if (/= lnum 0) (progn (if (= lnum altlnum) (command pkt1) (progn (if (= ipl 1) (progn (command "") (setq ipl 0) ) ) (command "-layer" "m" lcode "") (setq larc 0) (command "3dpoly" pkt1) (setq ipl 1) ) ) ) ) ; ; (setq altlnum lnum) (setq pkt2 pkt1) ) ) ) ) (setq zi (read-line fi)) ) (close fi) (setq offen 0) (if (= ipl 1)(command "")) ) ) ; ; Einlesen der Einzelpunkte, Höhen und Nummern ; (if (/= auswahl 2) (progn (if (= offen 0) (progn (setq fi (open fnm "r")) (setq offen 1) ) (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") ) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (setq pnr (substr zi 7 13)) (setq ende 1) (while ende (if (= (substr pnr 1 1) " ") (setq pnr (substr pnr 2 (1- (strlen pnr)))) (setq ende nil) ) ) ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq sym (substr zi 60 3)) (setq ende 1) (while ende (if (= (substr sym 1 1) " ") (setq sym (substr sym 2 (1- (strlen sym)))) (setq ende nil) ) ) ; (if (> (strlen zi) 68) (setq symricht (atof (substr zi 69 10))) (setq symricht 0.0) ) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq mitnum 0) (setq xnum 1) (if (= (strlen pnr) 5) (if (= lcode "18") (if (= (substr pnr 1 1) "6") (setq xnum 0)) ) ) (if (= nummern 4) (if (/= pnr "") (if (= xnum 1) (if (= auswahl 4) (setq mitnum 1) (progn (if (= linien 2) (setq mitnum 1)) (if (/= sym "") (if (= einzel 1) (setq mitnum 1)) ) ) ) ) ) ) ; (setq mithoeh 0) (setq xhoeh 1) (if (= (strlen pnr) 5) (if (= lcode "18") (if (= (substr pnr 1 1) "6") (setq xhoeh 0)) ) ) (if (= hoehen 8) (if (/= lcode "199") (if (= xhoeh 1) (if (/= zzz 0.0) (if (= auswahl 8) (setq mithoeh 1) (progn (if (= linien 2) (setq mithoeh 1)) (if (/= sym "") (if (= einzel 1) (setq mithoeh 1)) ) ) ) ) ) ) ) ; (setq pkt1 (list xxx yyy)) ; ; ; (if (= mitnum 1) (progn (if (= hset 0) (setq hset 2) (if (= hset 1) (setq hset 3) ) ) (if (/= sym "") (progn (setq numlay "einzelnum") (if (= sym "6") (setq numlay "grenznum")) (if (= sym "7") (setq numlay "grenznum")) (if (= sym "600") (setq numlay "grenznum")) (if (= sym "601") (setq numlay "grenznum")) (if (= (substr sym 1 2) "43") (setq numlay "snum")) (command "-layer" "m" numlay "") ) (progn (command "-layer" "m" "krznum" "" "einfüge" "nkrz" pkt1 fkt "" richt) (setq numlay "sonstnum") (if (= lcode "13") (setq numlay "gebnum")) (if (= lcode "2") (setq numlay "boeschnum")) (if (= lcode "3") (setq numlay "boeschnum")) (if (= lcode "4") (setq numlay "boeschnum")) (if (= lcode "21") (setq numlay "stranum")) (if (= lcode "22") (setq numlay "stranum")) (if (= lcode "23") (setq numlay "stranum")) (if (= lcode "24") (setq numlay "stranum")) (if (= lcode "25") (setq numlay "stranum")) (if (= lcode "26") (setq numlay "stranum")) (if (= lcode "27") (setq numlay "stranum")) (if (= lcode "28") (setq numlay "stranum")) (if (= lcode "6") (setq numlay "grenznum")) (if (= lcode "7") (setq numlay "grenznum")) (if (= lcode "600") (setq numlay "grenznum")) (if (= lcode "601") (setq numlay "grenznum")) (command "-layer" "m" numlay "") ) ) (if (and (/= sym "99") (/= sym "991") (/= sym "8")) (progn (setq txp1 (+ xxx (* willxu 1.5))) (setq txp2 (+ yyy (* willyu 1.5))) (setq txp (list txp1 txp2)) (command "text" "p" "ol" txp (* zusch 1.8) richt pnr) ) ) ) ) ; ; (if (= mithoeh 1) (progn (if (= sym "") (progn (command "-layer" "m" (strcat "H" lcode) "") (command "einfüge" "hkrz" pkt1 fkt "" richt) ) (command "-layer" "m" (strcat "H" sym) "") ) (if (= hset 0) (setq hset 1) (if (= hset 2) (setq hset 3) ) ) (setq txp1 (+ xxx (* willxo 1.12))) (setq txp2 (+ yyy (* willyo 1.12))) (setq txp (list txp1 txp2)) (command "text" txp hscala richt (rtos zzz 2 2)) ; ; --> die letzte Ziffer n bei (rtos zzz 2 n) bedeutet die Anzahl der Nachkommastellen ! ; ) ) ; ; (if (= einzel 1) (if (/= sym "") (progn ; ; SYMBOLCODES SETZEN ; (command "-layer" "m" sym "") ; (setq ix 0) ; (if (= sym "1") ; Heizungsschacht (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "hzgs") ) ) ; (if (= sym "6" ) (setsym "grenz1")) ; GRENZPUNKT aufgemessen (if (= sym "7" ) (setsym "grenz2")) ; GRENZPUNKT übernommen (if (= sym "701" ) (setsym "grenz3")) ; GRENZPUNKT nicht abgemarkt ; (if (= sym "8") ; TP (progn (setsym "tpkt") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "9") ; FERNMELDESCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "fms") ) ) ; (if (= sym "10") (setsym "nbaum")) ; NADELBAUM (if (= sym "11") (setsym "lbaum")) ; LAUBBAUM (if (= sym "119") (setsym "stumpf")) ; BAUMSTUMPF (if (= sym "111") (setsym "obaum")) ; OBSTBAUM (if (= sym "12") (setsym "heckp")) ; HECKENPUNKT (if (= sym "121") (setsym "gebue-gm")); GEBÜSCH gemessen (if (= sym "19") (setsym "hfp")) ; HÖHENFESTPUNKT / MB (if (= sym "191") (setsym "MB")) ; HÖHENFESTPUNKT / MB (if (= sym "21") (setsym "fahrbm")) ; FAHRBAHNMITTE (if (= sym "282") (setsym "PFEIL-HR")); PFEIL HALBRECHTS (if (= sym "30") (setsym "verkz1")) ; VERKEHRSZEICHEN (if (= sym "301") (setsym "verkz4")) ; HINWEISSCHILD (if (= sym "302") (setsym "strs")) ; STRASSENNAME (if (= sym "303") (setsym "hst")) ; HALTESTELLE (if (= sym "31") (setsym "verkz2")) ; AMPEL (if (= sym "311") (setsym "sig")) ; SIGNAL (if (= sym "312") (setsym "schranke")); SCHRANKE (if (= sym "313") (setsym "wbake")) ; WARNBAKE (if (= sym "314") (setsym "wkreuz")) ; WARN-/ANDREASKREUZ (if (= sym "321") (setsym "kms1")) ; KILOMETERSTEIN Straße (if (= sym "322") (setsym "kms2")) ; KILOMETERSTEIN Eisenbahn (if (= sym "323") (setsym "station")) ; STATIONSZEICHEN (if (= sym "33") (setsym "verkz3")) ; ORTSDURCHFAHRTSSCHILD (if (= sym "35") (setsym "rs")) ; ROHRSOHLE (if (= sym "36") (setsym "fmast")) ; FAHNENMAST ; (if (= sym "37") ; ANSCHLAGSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "ans") ) ) ; (if (= sym "38") ; WASSERSCHACHT rechteckig (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "wscha1") ) ) ; (if (= sym "381") ; WASSERSCHACHT rund (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "wscha2") ) ) ; (if (= sym "382") (setsym "rst")) ; ROHRSTUTZEN ; (if (= sym "39") (setsym "dkm")) ; DENKMAL (if (= sym "40") (setsym "br1")) ; SPRINGBRUNNEN (if (= sym "41") (setsym "ws")) ; WASSERSCHIEBER (if (= sym "411") (setsym "as")) ; ABWASSERSCHIEBER (if (= sym "412") (setsym "has")) ; HAUSANSCHLUSSSCHIEBER (if (= sym "413") (setsym "bl-ha")) ; HAUSANSCHLUáSCHIEBER (if (= sym "42") (setsym "hydr1")) ; ÜBERFLURHYDRANT (if (= sym "431") (setsym "schacht1")); ABWASSERSCHACHT rund (if (= sym "432") (setsym "schacht2")); ABWASSERSCHACHT rechteckig (if (= sym "433") (setsym "schacht3")); EINLAUFSCHACHT rund (if (= sym "434") (setsym "schacht4")); EINLAUFSCHACHT rechteckig (if (= sym "435") (setsym "Dscha")) ; DRAINAGESCHACHT (if (= sym "44") (setsym "einl1")) ; EINLAUF (if (= sym "441") (setsym "einl2")) ; STRASSENEINLAUF (if (= sym "442") (setsym "einl3")) ; SEITENEINLAUF (if (= sym "45") (setsym "hydr2")) ; UNTERFLURHYDRANT (if (= sym "50") (setsym "mast1")) ; STAHLGITTERMAST (if (= sym "51") (setsym "mast2")) ; STAHLROHRMAST (if (= sym "52") (setsym "mast3")) ; BETONMAST (if (= sym "53") (setsym "mast4")) ; HOLZMAST (if (= sym "507") (setsym "lmast1")) ; STAHLGITTERMAST mit Leuchte (if (= sym "517") (setsym "lmast2")) ; STAHLROHRMAST mit Leuchte (if (= sym "527") (setsym "lmast3")) ; BETONMAST mit Leuchte (if (= sym "537") (setsym "lmast4")) ; HOLZMAST mit Leuchte ; (if (= sym "54") ; KABELSCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "ksch") ) ) ; (if (= sym "541") ; KABELSCHACHT doppelt (progn (if (> symricht 150.0) (if (< symricht 350.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (if (>= symricht 350.0) (setsym "ksch2") (if (<= symricht 50.0) (setsym "ksch2") (setsym "ksch1") ) ) ) ) ; (if (= sym "542") (setsym "k-lsa")) ; KABELSCHACHT LSA ; (if (= sym "55") (setsym "kabst")) ; KABELSTEIN ; (if (= sym "551") ; PRELLSTEIN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "prell") ) ) ; (if (= sym "56") ; SCHALTKASTEN (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "schk") ) ) ; (if (= sym "561") ; SCHALTKASTEN / ELT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "elt") ) ) ; (if (= sym "562") ; SCHALTKASTEN / TEL (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-tel") ) ) ; (if (= sym "563") ; SCHALTKASTEN / TV (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-TV") ) ) ; (if (= sym "57") (setsym "lat")) ; LATERNE (if (= sym "571") (setsym "scheinw")) ; SCHEINWERFER ; (if (= sym "58") ; RUFSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "rufs") ) ) ; (if (= sym "595") (setsym "ltg")) ; UK Elektroleitung (if (= sym "596") (setsym "fd")) ; UF Fahrdraht ; (if (= sym "61") (setsym "planke")) ; LEITPLANKE (if (= sym "622") (setsym "spf1")) ; SPERRPFOSTEN (if (= sym "623") (setsym "spf2")) ; HšLSE FšR SPERRPFOSTEN (if (= sym "64") (setsym "gass")) ; GASSÄULE / MERKSTEIN ; (if (= sym "651") ; PARKUHR (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (+ symricht 200.0))) ) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (setsym "puhr") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "p-autom") ) ) ; (if (= sym "67") (setsym "gwt")) ; GASWASSERTOPF ; (if (= sym "74") ; TRANSFORMATORENHÄUSCHEN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "trafo") ) ) ; (if (= sym "76") (setsym "oel")) ; OELABSCHEIDER (if (= sym "761") (setsym "benzin")) ; BEZINABSCHEIDER ; (if (= sym "79") ; TELEFONZELLE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "tele") ) ) ; (if (= sym "70") (setsym "poll")) ; POLLER (if (= sym "80") (setsym "br2")) ; BRUNNEN öffentl. Wasservers. ; (if (= sym "83") ; BRIEFKASTEN (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "briefk") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "p-autom") ) ) ; (if (= sym "84") (setsym "stütze")) ; STÜTZE (if (= sym "89") (setsym "klgr")) ; KLÄRGRUBE rund (if (= sym "891") (setsym "klgr1")) ; KLÄRGRUBE variabel (if (= sym "90") (setsym "wass")) ; WASSERSÄULE (if (= sym "901") (setsym "luf")) ; ENTLÜFTUNG (if (= sym "91") (setsym "gs")) ; GASSCHIEBER (if (= sym "921") (setsym "bohr1")) ; KERNBOHRPUNKT (if (= sym "922") (setsym "bohr2")) ; BOHRPUNKT (if (= sym "923") (setsym "bohr3")) ; PEGELBOHRPUNKT (if (= sym "93") (setsym "ok")) ; OBERKANTE (if (= sym "931") (setsym "okfeg")) ; OBERKANTE FB EG (if (= sym "932") (setsym "okfkg")) ; OBERKANTE FB KG (if (= sym "94") (setsym "uk")) ; UNTERKANTE (if (= sym "95") (setsym "fallr")) ; FALLROHR (if (= sym "97") (setsym "flmst")) ; FLUTLICHTMAST ; (if (= sym "99") ; POLYGONPUNKT (progn (setsym "pp") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "991") ; AP (progn (setsym "ap") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= ix 0) (progn (setq symricht richt) (setsym "pkt") ) ) ) ) ) ) ) ; (setq zi (read-line fi)) ) (close fi) (setq offen 0) ) ) ) ) ) (progn (write-line " Kein Dateiname eingegeben ! ") (write-line "") (graphscr) ) ) ) ) ; ; LIMITEN ANPASSEN ; (setq minx (car (getvar "extmin"))) (setq miny (cadr (getvar "extmin"))) (setq maxx (car (getvar "extmax"))) (setq maxy (cadr (getvar "extmax"))) (setvar "limmin" (list minx miny)) (setvar "limmax" (list maxx maxy)) ; ; L™SCHEN DER ALTEN GITTERKREUZE ; (setq asatz (ssget "X" '((8 . "GITTER")))) (if (/= asatz nil) (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (if (= (cdr (assoc 0 edefi)) "INSERT") (entdel (ssname asatz counter))) (setq counter (1+ counter)) ) (setq asatz nil) ) ) ; ; Setzen der neuen Gitterkreuze ; (if (= rasta 1) (if (> maxx minx) (progn (command "limiten" "aus") (if (= offen 2) (command "-layer" "t" "*" "ei" "*" "") (if (= mitgitter 1) (command "-layer" "t" "gitter" "")) ) ; (setq xuanz (fix (/ (- maxx minx) abst))) (setq yuanz (fix (/ (- maxy miny) abst))) (setq xmi (* abst (fix (/ minx abst)) 1.0)) (setq ymi (* abst (fix (/ miny abst)) 1.0)) ; (setq pt3 (list xmi ymi)) (command "-layer" "m" "gitter" "") (command "einfüge" "krz" pt3 fkt "" "") (command "reihe" (entlast) "" "r" (+ yuanz 2) (+ xuanz 2) abst abst) ) ) ) ; ; Wiederherstellen der Systemvariablen ; (if (= offen 2) (if (= hset 0) (command "-layer" "se" "0" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "*num" "") (command "-layer" "se" "0" "fr" "*num" "fr" "h*" "") ) ) ) ; (if (= hset 0) (command "-layer" "se" "0" "fr" "gitter" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "gitter" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "") (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "fr" "h*" "") ) ) ) ) ; (setq neusetz (getvar "clayer")) (if (/= gesetzt neusetz) (progn (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (= lname gesetzt) (progn (if (= (boole 1 flaggy 1) 1) (command "-layer" "t" lname "")) (command "-layer" "se" lname "") (setq zh nil) ) (setq zh (read-line fh)) ) ) (close fh) ) ) ) ) (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (if (/= zh nil) (progn (command "-layer") (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (/= gesetzt lname) (if (= (boole 1 flaggy 1) 1) (command "fr" lname) (command "t" lname) ) ) (setq zh (read-line fh)) ) (command "") ) ) (close fh) ) ) (command "DEL" "LAYER.TAB") (setvar "REGENMODE" 1) (command "zoom" "a") ; (setvar "dragmode" save05) (setvar "regenmode" save06) (setvar "osmode" save07) (setvar "aunits" save01) (setvar "angbase" save02) (setvar "angdir" save03) (setvar "splinetype" save04) ; (setq rasta nil) (reset_err) ; ) ; ; ; ; ; Variante WAD mit 3d-Einlesen und alle Symbole PKT ; (defun C:wadkart3d () ; (init_err) (textscr) (setq hset 0) ; (setq gesetzt (getvar "CLAYER")) (setq fh (open "LAYER.TAB" "w")) (setq mitgitter 0) (if (/= fh nil) (progn (setq edefi2 (tblnext "LAYER" "1")) (while (/= edefi2 nil) (setq lname (cdr (assoc 2 edefi2))) (if (= lname "GITTER") (setq mitgitter 1)) (while (< (strlen lname) 40) (setq lname (strcat lname " "))) (setq lflag (itoa (cdr (assoc 70 edefi2)))) (while (< (strlen lflag) 4) (setq lflag (strcat " " lflag))) (write-line (strcat lname lflag) fh) (setq edefi2 (tblnext "LAYER")) ) (close fh) ) ) ; (write-line "") (setq mst (getint "Maßstab 1 : XXXX <500> : ")) (if (= mst nil) (setq mst 500.0)) (write-line "") (setq abst (fix (/ mst 10))) (setq fkt (/ mst 714.28571)) (setq zusch (/ mst 750.0)) (setq hscala (/ mst 666.6667)) ; ; Sicherung der zu verändernden Systemvariablen ; (setq save01 (getvar "AUNITS")) (setq save02 (getvar "ANGBASE")) (setq save03 (getvar "ANGDIR")) (setq save04 (getvar "SPLINETYPE")) (setq save05 (getvar "DRAGMODE")) (setq save06 (getvar "REGENMODE")) (setq save07 (getvar "OSMODE")) ; ; Setzen der Variablen ; (setvar "AUNITS" 2) (setvar "ANGDIR" 1) (setvar "ANGBASE" (/ pi 2.0)) (setvar "SPLINETYPE" 6) (setvar "CMDECHO" 0) (setvar "DRAGMODE" 0) (setvar "REGENMODE" 0) (setvar "OSMODE" 0) ; (setq richt (getreal "Textrichtung <0> : ")) (if (= richt nil) (setq richt 100.0) (setq richt (- 500.0 richt))) (if (>= richt 400.0) (setq richt (- richt 400.0))) (write-line "") ; ; Berechnung der Verschiebemaße für die Beschriftungen ; (setq willxo (* (sin (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willyo (* (cos (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willxu (* (sin (* (/ (+ richt 12.0) 200.0) pi)) zusch)) (setq willyu (* (cos (* (/ (+ richt 12.0) 200.0) pi)) zusch)) ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 Einzelpunkte ") (write-line " 2 Linien ") (write-line " 4 Punktnummern ") (write-line " 8 Höhen ") (write-line "") (setq auswahl (getint "Ihre Eingabe <15> : ")) (if (= auswahl nil) (setq auswahl 15)) (write-line "") ; (write-line "Bitte wählen Sie aus :") (write-line "") (write-line " 1 mit Raster setzen") (write-line " 2 ohne Raster setzen") (write-line "") (setq rasta (getint "Ihre Eingabe <1> : ")) (write-line "") (IF (/= rasta 2) (setq rasta 1)) ; ; (setq offen 2) (if (/= auswahl 0) (progn (setq einzel (boole 1 auswahl 1)) (setq linien (boole 1 auswahl 2)) (setq nummern (boole 1 auswahl 4)) (setq hoehen (boole 1 auswahl 8)) ; (command "stil" "normal" "romans" "0.0" "1.0" "" "" "" "") (command "farbe" "vonlayer") (setq fnm (getstring "Lesen von Datei : ")) (write-line "") ; (if (/= fnm "") (progn ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line (strcat " Datei " fnm " wurde nicht gefunden ! ")) (write-line "") (graphscr) ) (progn ; ; Einlesen der Linien (Höhenschichtlinien als Polylinie) ; (setq offen 1) (if (= linien 2) (progn (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") (setq polylin 0) (setq altlnum 0) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (if (/= (substr zi 66 3) " 0") (progn ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq lnum (atoi (substr zi 53 4))) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq bog (atoi (substr zi 65 1))) (setq pkt1 (list xxx yyy zzz)) (setq pkt3 (list xxx yyy)) ; ; (if (/= lnum 0) (progn (if (= bog 1) ; BOGENANFANG (setq banfpkt pkt1) ) ; (if (= lnum altlnum) (progn ; (if (< bog 2) (progn (if (= polylin 0) (command "linie" pkt2 pkt1 "") (progn (if (= larc 1) (command "li")) (setq larc 0) (command pkt3) ) ) ) ) ; (if (>= bog 3) (progn (if (= lcode "199") (progn (setq vfkt (* (distance banfpkt pkt1) 0.5)) (setq symricht (- 400.0 (* (/ (angle banfpkt pkt1) pi) 200.0))) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (command "einfüge" "zaun1" pkt2 vfkt "" symricht) ) (progn (if (= polylin 0) (command "bogen" banfpkt pkt2 pkt1) (progn (if (= larc 0) (command "k")) (command "p" pkt4 pkt3) (setq larc 1) ) ) (if (= bog 4) (setq banfpkt pkt1)) ) ) ) ) ; ) (progn (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) (command "-layer" "m" lcode "") (setq polylin 0) (setq larc 0) (if (= lcode "100") (setq polylin 1)) (if (= lcode "101") (setq polylin 1)) (if (= polylin 1) (command "plinie" pkt3)) ) ) ) ) ; ; (setq altlnum lnum) (setq pkt2 pkt1) (setq pkt4 pkt3) ) ) ) ) (setq zi (read-line fi)) ) (close fi) (setq offen 0) (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) ) ) ; ; Einlesen der Einzelpunkte, Höhen und Nummern ; (if (/= auswahl 2) (progn (if (= offen 0) (progn (setq fi (open fnm "r")) (setq offen 1) ) (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") ) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (setq pnr (substr zi 7 13)) (setq ende 1) (while ende (if (= (substr pnr 1 1) " ") (setq pnr (substr pnr 2 (1- (strlen pnr)))) (setq ende nil) ) ) ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq sym (substr zi 60 3)) (setq ende 1) (while ende (if (= (substr sym 1 1) " ") (setq sym (substr sym 2 (1- (strlen sym)))) (setq ende nil) ) ) ; (if (> (strlen zi) 68) (setq symricht (atof (substr zi 69 10))) (setq symricht 0.0) ) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq mitnum 0) (setq xnum 1) (if (= (strlen pnr) 5) (if (= lcode "18") (if (= (substr pnr 1 1) "6") (setq xnum 0)) ) ) (if (= nummern 4) (if (/= pnr "") (if (= xnum 1) (if (= auswahl 4) (setq mitnum 1) (progn (if (= linien 2) (setq mitnum 1)) (if (/= sym "") (if (= einzel 1) (setq mitnum 1)) ) ) ) ) ) ) ; (setq mithoeh 0) (setq xhoeh 1) (if (= (strlen pnr) 5) (if (= lcode "18") (if (= (substr pnr 1 1) "6") (setq xhoeh 0)) ) ) (if (= hoehen 8) (if (/= lcode "199") (if (= xhoeh 1) (if (/= zzz 0.0) (if (= auswahl 8) (setq mithoeh 1) (progn (if (= linien 2) (setq mithoeh 1)) (if (/= sym "") (if (= einzel 1) (setq mithoeh 1)) ) ) ) ) ) ) ) ; (setq pkt1 (list xxx yyy zzz)) (setq pkt3 (list xxx yyy)) ; ; ; (if (= mitnum 1) (progn (if (= hset 0) (setq hset 2) (if (= hset 1) (setq hset 3) ) ) (if (/= sym "") (progn (setq numlay "einzelnum") (if (= sym "6") (setq numlay "grenznum")) (if (= sym "7") (setq numlay "grenznum")) (if (= sym "600") (setq numlay "grenznum")) (if (= sym "601") (setq numlay "grenznum")) (if (= (substr sym 1 2) "43") (setq numlay "snum")) (command "-layer" "m" numlay "") ) (progn (command "-layer" "m" "krznum" "" "einfüge" "nkrz" pkt1 fkt "" richt) (setq numlay "sonstnum") (if (= lcode "13") (setq numlay "gebnum")) (if (= lcode "2") (setq numlay "boeschnum")) (if (= lcode "3") (setq numlay "boeschnum")) (if (= lcode "4") (setq numlay "boeschnum")) (if (= lcode "21") (setq numlay "stranum")) (if (= lcode "22") (setq numlay "stranum")) (if (= lcode "23") (setq numlay "stranum")) (if (= lcode "24") (setq numlay "stranum")) (if (= lcode "25") (setq numlay "stranum")) (if (= lcode "26") (setq numlay "stranum")) (if (= lcode "27") (setq numlay "stranum")) (if (= lcode "28") (setq numlay "stranum")) (if (= lcode "6") (setq numlay "grenznum")) (if (= lcode "7") (setq numlay "grenznum")) (if (= lcode "600") (setq numlay "grenznum")) (if (= lcode "601") (setq numlay "grenznum")) (command "-layer" "m" numlay "") ) ) (if (and (/= sym "99") (/= sym "991") (/= sym "8")) (progn (setq txp1 (+ xxx (* willxu 1.5))) (setq txp2 (+ yyy (* willyu 1.5))) (setq txp (list txp1 txp2)) (command "text" "p" "ol" txp (* zusch 1.8) richt pnr) ) ) ) ) ; ; (if (= mithoeh 1) (progn (if (= sym "") (progn (command "-layer" "m" (strcat "H" lcode) "") (command "einfüge" "hkrz" pkt1 fkt "" richt) ) (command "-layer" "m" (strcat "H" sym) "") ) (if (= hset 0) (setq hset 1) (if (= hset 2) (setq hset 3) ) ) (setq txp1 (+ xxx (* willxo 1.12))) (setq txp2 (+ yyy (* willyo 1.12))) (setq txp (list txp1 txp2)) (command "text" txp hscala richt (rtos zzz 2 2)) ; ; --> die letzte Ziffer n bei (rtos zzz 2 n) bedeutet die Anzahl der Nachkommastellen ! ; ) ) ; ; (if (= einzel 1) (if (/= sym "") (progn ; ; SYMBOLCODES SETZEN ; (command "-layer" "m" sym "") ; (setq ix 0) ; (if (= sym "1") ; Heizungsschacht (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "6" ) (setsym "pkt")) ; GRENZPUNKT aufgemessen (if (= sym "7" ) (setsym "pkt")) ; GRENZPUNKT übernommen (if (= sym "701" ) (setsym "pkt")) ; GRENZPUNKT nicht abgemarkt ; (if (= sym "8") ; TP (progn (setsym "pkt") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "9") ; FERNMELDESCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "10") (setsym "pkt")) ; NADELBAUM (if (= sym "11") (setsym "pkt")) ; LAUBBAUM (if (= sym "111") (setsym "pkt")) ; OBSTBAUM (if (= sym "12") (setsym "pkt")) ; HECKENPUNKT (if (= sym "121") (setsym "pkt")); GEBÜSCH gemessen (if (= sym "19") (setsym "pkt")) ; HÖHENFESTPUNKT / MB (if (= sym "21") (setsym "fahrbm")) ; FAHRBAHNMITTE (if (= sym "282") (setsym "PFEIL-HR")); PFEIL HALBRECHTS (if (= sym "30") (setsym "pkt")) ; VERKEHRSZEICHEN (if (= sym "301") (setsym "pkt")) ; HINWEISSCHILD (if (= sym "302") (setsym "pkt")) ; STRASSENNAME (if (= sym "303") (setsym "pkt")) ; HALTESTELLE (if (= sym "31") (setsym "pkt")) ; AMPEL (if (= sym "311") (setsym "pkt")) ; SIGNAL (if (= sym "312") (setsym "pkt")); SCHRANKE (if (= sym "313") (setsym "pkt")) ; WARNBAKE (if (= sym "314") (setsym "pkt")) ; WARN-/ANDREASKREUZ (if (= sym "321") (setsym "pkt")) ; KILOMETERSTEIN Straße (if (= sym "322") (setsym "pkt")) ; KILOMETERSTEIN Eisenbahn (if (= sym "323") (setsym "pkt")) ; STATIONSZEICHEN (if (= sym "33") (setsym "pkt")) ; ORTSDURCHFAHRTSSCHILD (if (= sym "35") (setsym "pkt")) ; ROHRSOHLE (if (= sym "36") (setsym "pkt")) ; FAHNENMAST ; (if (= sym "37") ; ANSCHLAGSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "38") ; WASSERSCHACHT rechteckig (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "381") ; WASSERSCHACHT rund (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "382") (setsym "pkt")) ; ROHRSTUTZEN ; (if (= sym "39") (setsym "pkt")) ; DENKMAL (if (= sym "40") (setsym "pkt")) ; SPRINGBRUNNEN (if (= sym "41") (setsym "pkt")) ; WASSERSCHIEBER (if (= sym "411") (setsym "pkt")) ; ABWASSERSCHIEBER (if (= sym "412") (setsym "pkt")) ; HAUSANSCHLUSSSCHIEBER (if (= sym "413") (setsym "pkt")) ; HAUSANSCHLUáSCHIEBER (if (= sym "42") (setsym "pkt")) ; ÜBERFLURHYDRANT (if (= sym "431") (setsym "pkt")); ABWASSERSCHACHT rund (if (= sym "432") (setsym "pkt")); ABWASSERSCHACHT rechteckig (if (= sym "433") (setsym "pkt")); EINLAUFSCHACHT rund (if (= sym "434") (setsym "pkt")); EINLAUFSCHACHT rechteckig (if (= sym "435") (setsym "pkt")) ; DRAINAGESCHACHT (if (= sym "44") (setsym "pkt")) ; EINLAUF (if (= sym "441") (setsym "pkt")) ; STRASSENEINLAUF (if (= sym "442") (setsym "pkt")) ; SEITENEINLAUF (if (= sym "45") (setsym "pkt")) ; UNTERFLURHYDRANT (if (= sym "50") (setsym "pkt")) ; STAHLGITTERMAST (if (= sym "51") (setsym "pkt")) ; STAHLROHRMAST (if (= sym "52") (setsym "pkt")) ; BETONMAST (if (= sym "53") (setsym "pkt")) ; HOLZMAST (if (= sym "507") (setsym "pkt")) ; STAHLGITTERMAST mit Leuchte (if (= sym "517") (setsym "pkt")) ; STAHLROHRMAST mit Leuchte (if (= sym "527") (setsym "pkt")) ; BETONMAST mit Leuchte (if (= sym "537") (setsym "pkt")) ; HOLZMAST mit Leuchte ; (if (= sym "54") ; KABELSCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "541") ; KABELSCHACHT doppelt (progn (if (> symricht 150.0) (if (< symricht 350.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (if (>= symricht 350.0) (setsym "pkt") (if (<= symricht 50.0) (setsym "pkt") (setsym "pkt") ) ) ) ) ; (if (= sym "542") (setsym "pkt")) ; KABELSCHACHT LSA ; (if (= sym "55") (setsym "pkt")) ; KABELSTEIN ; (if (= sym "551") ; PRELLSTEIN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "56") ; SCHALTKASTEN (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "561") ; SCHALTKASTEN / ELT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "pkt") ) ) ; (if (= sym "562") ; SCHALTKASTEN / TEL (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "pkt") ) ) ; (if (= sym "563") ; SCHALTKASTEN / TV (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "schk-TV") ) ) ; (if (= sym "57") (setsym "pkt")) ; LATERNE (if (= sym "571") (setsym "pkt")) ; SCHEINWERFER ; (if (= sym "58") ; RUFSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "595") (setsym "pkt")) ; UK Elektroleitung (if (= sym "596") (setsym "pkt")) ; UF Fahrdraht ; (if (= sym "61") (setsym "pkt")) ; LEITPLANKE (if (= sym "622") (setsym "pkt")) ; SPERRPFOSTEN (if (= sym "623") (setsym "pkt")) ; HšLSE FšR SPERRPFOSTEN (if (= sym "64") (setsym "pkt")) ; GASSÄULE / MERKSTEIN ; (if (= sym "651") ; PARKUHR (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (+ symricht 200.0))) ) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "pkt") ) ) ; (if (= sym "67") (setsym "pkt")) ; GASWASSERTOPF ; (if (= sym "74") ; TRANSFORMATORENHÄUSCHEN (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "76") (setsym "pkt")) ; OELABSCHEIDER (if (= sym "761") (setsym "pkt")) ; BEZINABSCHEIDER ; (if (= sym "79") ; TELEFONZELLE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "pkt") ) ) ; (if (= sym "70") (setsym "pkt")) ; POLLER (if (= sym "80") (setsym "pkt")) ; BRUNNEN öffentl. Wasservers. ; (if (= sym "83") ; BRIEFKASTEN (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "pkt") ) ) ; (if (= sym "652") ; PARKSCHEINAUTOMAT (progn (if (>= symricht 200.0) (setq symricht (- symricht 200.0))) (setsym "pkt") ) ) ; (if (= sym "84") (setsym "pkt")) ; STÜTZE (if (= sym "89") (setsym "pkt")) ; KLÄRGRUBE rund (if (= sym "891") (setsym "pkt")) ; KLÄRGRUBE variabel (if (= sym "90") (setsym "pkt")) ; WASSERSÄULE (if (= sym "901") (setsym "pkt")) ; ENTLÜFTUNG (if (= sym "91") (setsym "pkt")) ; GASSCHIEBER (if (= sym "921") (setsym "pkt")) ; KERNBOHRPUNKT (if (= sym "922") (setsym "pkt")) ; BOHRPUNKT (if (= sym "923") (setsym "pkt")) ; PEGELBOHRPUNKT (if (= sym "93") (setsym "pkt")) ; OBERKANTE (if (= sym "931") (setsym "pkt")) ; OBERKANTE FB EG (if (= sym "932") (setsym "pkt")) ; OBERKANTE FB KG (if (= sym "94") (setsym "pkt")) ; UNTERKANTE (if (= sym "95") (setsym "pkt")) ; FALLROHR (if (= sym "97") (setsym "pkt")) ; FLUTLICHTMAST ; (if (= sym "99") ; POLYGONPUNKT (progn (setsym "pkt") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "991") ; AP (progn (setsym "pkt") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= ix 0) (progn (setq symricht richt) (setsym "pkt") ) ) ) ) ) ) ) ; (setq zi (read-line fi)) ) (close fi) (setq offen 0) ) ) ) ) ) (progn (write-line " Kein Dateiname eingegeben ! ") (write-line "") (graphscr) ) ) ) ) ; ; LIMITEN ANPASSEN ; (setq minx (car (getvar "extmin"))) (setq miny (cadr (getvar "extmin"))) (setq maxx (car (getvar "extmax"))) (setq maxy (cadr (getvar "extmax"))) (setvar "limmin" (list minx miny)) (setvar "limmax" (list maxx maxy)) ; ; L™SCHEN DER ALTEN GITTERKREUZE ; (setq asatz (ssget "X" '((8 . "GITTER")))) (if (/= asatz nil) (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (if (= (cdr (assoc 0 edefi)) "INSERT") (entdel (ssname asatz counter))) (setq counter (1+ counter)) ) (setq asatz nil) ) ) ; ; Setzen der neuen Gitterkreuze ; (if (= rasta 1) (if (> maxx minx) (progn (command "limiten" "aus") (if (= offen 2) (command "-layer" "t" "*" "ei" "*" "") (if (= mitgitter 1) (command "-layer" "t" "gitter" "")) ) ; (setq xuanz (fix (/ (- maxx minx) abst))) (setq yuanz (fix (/ (- maxy miny) abst))) (setq xmi (* abst (fix (/ minx abst)) 1.0)) (setq ymi (* abst (fix (/ miny abst)) 1.0)) ; (setq pt3 (list xmi ymi)) (command "-layer" "m" "gitter" "") (command "einfüge" "krz" pt3 fkt "" "") (command "reihe" (entlast) "" "r" (+ yuanz 2) (+ xuanz 2) abst abst) ) ) ) ; ; Wiederherstellen der Systemvariablen ; (if (= offen 2) (if (= hset 0) (command "-layer" "se" "0" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "*num" "") (command "-layer" "se" "0" "fr" "*num" "fr" "h*" "") ) ) ) ; (if (= hset 0) (command "-layer" "se" "0" "fr" "gitter" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "gitter" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "") (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "fr" "h*" "") ) ) ) ) ; (setq neusetz (getvar "clayer")) (if (/= gesetzt neusetz) (progn (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (= lname gesetzt) (progn (if (= (boole 1 flaggy 1) 1) (command "-layer" "t" lname "")) (command "-layer" "se" lname "") (setq zh nil) ) (setq zh (read-line fh)) ) ) (close fh) ) ) ) ) (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (if (/= zh nil) (progn (command "-layer") (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (/= gesetzt lname) (if (= (boole 1 flaggy 1) 1) (command "fr" lname) (command "t" lname) ) ) (setq zh (read-line fh)) ) (command "") ) ) (close fh) ) ) (command "DEL" "LAYER.TAB") (setvar "REGENMODE" 1) (command "zoom" "a") ; (setvar "dragmode" save05) (setvar "regenmode" save06) (setvar "osmode" save07) (setvar "aunits" save01) (setvar "angbase" save02) (setvar "angdir" save03) (setvar "splinetype" save04) ; (setq rasta nil) (reset_err) ; ) ; ; ; kart - AutoCAD - Befehl zum Einlesen ; von Linien und Symbolen aus Tachymeteraufnahme ; mit variabler Layerauswahl ; ; neue Code- und Blockdefinitionen (März 2001) ; ; aktuelle Variante ; ; (defun C:vestra () ; (init_err) (textscr) (setq hset 0) ; (setq gesetzt (getvar "CLAYER")) (setq fh (open "LAYER.TAB" "w")) (setq mitgitter 0) (if (/= fh nil) (progn (setq edefi2 (tblnext "LAYER" "1")) (while (/= edefi2 nil) (setq lname (cdr (assoc 2 edefi2))) (if (= lname "GITTER") (setq mitgitter 1)) (while (< (strlen lname) 40) (setq lname (strcat lname " "))) (setq lflag (itoa (cdr (assoc 70 edefi2)))) (while (< (strlen lflag) 4) (setq lflag (strcat " " lflag))) (write-line (strcat lname lflag) fh) (setq edefi2 (tblnext "LAYER")) ) (close fh) ) ) ; (write-line "") (setq mst (getint "Maßstab 1 : XXXX <250> : ")) (if (= mst nil) (setq mst 250.0)) (write-line "") (setq abst (fix (/ mst 10))) (setq fkt (/ mst 714.28571)) (setq zusch (/ mst 750.0)) (setq hscala (/ mst 666.6667)) ; ; Sicherung der zu verändernden Systemvariablen ; (setq save01 (getvar "AUNITS")) (setq save02 (getvar "ANGBASE")) (setq save03 (getvar "ANGDIR")) (setq save04 (getvar "SPLINETYPE")) (setq save05 (getvar "DRAGMODE")) (setq save06 (getvar "REGENMODE")) (setq save07 (getvar "OSMODE")) ; ; Setzen der Variablen ; (setvar "AUNITS" 2) (setvar "ANGDIR" 1) (setvar "ANGBASE" (/ pi 2.0)) (setvar "SPLINETYPE" 6) (setvar "cmdecho" 0) (setvar "DRAGMODE" 0) (setvar "REGENMODE" 0) (setvar "OSMODE" 0) ; (setq richt (getreal "Textrichtung <0> : ")) (if (= richt nil) (setq richt 100.0) (setq richt (- 500.0 richt))) (if (>= richt 400.0) (setq richt (- richt 400.0))) (write-line "") ; ; Berechnung der Verschiebemaße für die Beschriftungen ; (setq willxo (* (sin (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willyo (* (cos (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willxu (* (sin (* (/ (+ richt 12.0) 200.0) pi)) zusch)) (setq willyu (* (cos (* (/ (+ richt 12.0) 200.0) pi)) zusch)) ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 Einzelpunkte ") (write-line " 2 Linien ") (write-line " 4 Punktnummern ") (write-line " 8 Höhen ") (write-line "") (setq auswahl (getint "Ihre Eingabe <3> : ")) (if (= auswahl nil) (setq auswahl 3)) (write-line "") ; (write-line "Bitte wählen Sie aus :") (write-line "") (write-line " 1 mit Raster setzen") (write-line " 2 ohne Raster setzen") (write-line "") (setq rasta (getint "Ihre Eingabe <2> : ")) (write-line "") (IF (/= rasta 2) (setq rasta 2)) ; ; (setq offen 2) (if (/= auswahl 0) (progn (setq einzel (boole 1 auswahl 1)) (setq linien (boole 1 auswahl 2)) (setq nummern (boole 1 auswahl 4)) (setq hoehen (boole 1 auswahl 8)) ; (command "stil" "normal" "romans" "0.0" "1.0" "" "" "" "") (command "farbe" "vonlayer") (setq fnm (getstring "Lesen von Datei : ")) (write-line "") ; (if (/= fnm "") (progn ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line (strcat " Datei " fnm " wurde nicht gefunden ! ")) (write-line "") (graphscr) ) (progn ; ; Einlesen der Linien (Höhenschichtlinien als Polylinie) ; (setq offen 1) (if (= linien 2) (progn (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") (setq polylin 0) (setq altlnum 0) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (if (/= (substr zi 66 3) " 0") (progn ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq lnum (atoi (substr zi 53 4))) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq bog (atoi (substr zi 65 1))) (setq pkt1 (list xxx yyy)) ; ; (if (/= lnum 0) (progn (if (= bog 1) ; BOGENANFANG (setq banfpkt pkt1) ) ; (if (= lnum altlnum) (progn ; (if (< bog 2) (progn (if (= polylin 0) (command "linie" pkt2 pkt1 "") (progn (if (= larc 1) (command "li")) (setq larc 0) (command pkt1) ) ) ) ) ; (if (>= bog 3) (progn (if (= lcode "199") (progn (setq vfkt (* (distance banfpkt pkt1) 0.5)) (setq symricht (- 400.0 (* (/ (angle banfpkt pkt1) pi) 200.0))) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (command "einfüge" "zaun1" pkt2 vfkt "" symricht) ) (progn (if (= polylin 0) (command "bogen" banfpkt pkt2 pkt1) (progn (if (= larc 0) (command "k")) (command "p" pkt2 pkt1) (setq larc 1) ) ) (if (= bog 4) (setq banfpkt pkt1)) ) ) ) ) ; ) (progn (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) (command "-layer" "m" lcode "") (setq polylin 0) (setq larc 0) (if (= lcode "100") (setq polylin 1)) (if (= lcode "101") (setq polylin 1)) (if (= polylin 1) (command "plinie" pkt1)) ) ) ) ) ; ; (setq altlnum lnum) (setq pkt2 pkt1) ) ) ) ) (setq zi (read-line fi)) ) (close fi) (setq offen 0) (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) ) ) ; ; Einlesen der Einzelpunkte, Höhen und Nummern ; (if (/= auswahl 2) (progn (if (= offen 0) (progn (setq fi (open fnm "r")) (setq offen 1) ) (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") ) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (setq pnr (substr zi 7 13)) (setq ende 1) (while ende (if (= (substr pnr 1 1) " ") (setq pnr (substr pnr 2 (1- (strlen pnr)))) (setq ende nil) ) ) ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq sym (substr zi 60 3)) (setq ende 1) (while ende (if (= (substr sym 1 1) " ") (setq sym (substr sym 2 (1- (strlen sym)))) (setq ende nil) ) ) ; (if (> (strlen zi) 68) (setq symricht (atof (substr zi 69 10))) (setq symricht 0.0) ) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq mitnum 0) (setq xnum 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xnum 0)) ) (if (= nummern 4) (if (/= pnr "") (if (= xnum 1) (if (= auswahl 4) (setq mitnum 1) (progn (if (= linien 2) (setq mitnum 1)) (if (/= sym "") (if (= einzel 1) (setq mitnum 1)) ) ) ) ) ) ) ; (setq mithoeh 0) (setq xhoeh 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xhoeh 0)) ) (if (= hoehen 8) (if (/= lcode "199") (if (= xhoeh 1) (if (/= zzz 0.0) (if (= auswahl 8) (setq mithoeh 1) (progn (if (= linien 2) (setq mithoeh 1)) (if (/= sym "") (if (= einzel 1) (setq mithoeh 1)) ) ) ) ) ) ) ) ; (setq pkt1 (list xxx yyy)) ; ; ; (if (= mitnum 1) (progn (if (= hset 0) (setq hset 2) (if (= hset 1) (setq hset 3) ) ) (if (/= sym "") (progn (setq numlay "einzelnum") (if (= sym "6") (setq numlay "grenznum")) (if (= sym "7") (setq numlay "grenznum")) (if (= sym "600") (setq numlay "grenznum")) (if (= sym "601") (setq numlay "grenznum")) (if (= (substr sym 1 2) "43") (setq numlay "snum")) (command "-layer" "m" numlay "") ) (progn (command "-layer" "m" "krznum" "" "einfüge" "nkrz" pkt1 fkt "" richt) (setq numlay "sonstnum") (if (= lcode "13") (setq numlay "gebnum")) (if (= lcode "131") (setq numlay "gebnum")) (if (= lcode "2") (setq numlay "boeschnum")) (if (= lcode "3") (setq numlay "boeschnum")) (if (= lcode "4") (setq numlay "boeschnum")) (if (= lcode "21") (setq numlay "stranum")) (if (= lcode "22") (setq numlay "stranum")) (if (= lcode "23") (setq numlay "stranum")) (if (= lcode "24") (setq numlay "stranum")) (if (= lcode "25") (setq numlay "stranum")) (if (= lcode "26") (setq numlay "stranum")) (if (= lcode "27") (setq numlay "stranum")) (if (= lcode "28") (setq numlay "stranum")) (if (= lcode "6") (setq numlay "grenznum")) (if (= lcode "7") (setq numlay "grenznum")) (if (= lcode "600") (setq numlay "grenznum")) (if (= lcode "601") (setq numlay "grenznum")) (command "-layer" "m" numlay "") ) ) (if (and (/= sym "99") (/= sym "991") (/= sym "8")) (progn (setq txp1 (+ xxx (* willxu 1.5))) (setq txp2 (+ yyy (* willyu 1.5))) (setq txp (list txp1 txp2)) (command "text" "p" "ol" txp (* zusch 1.8) richt pnr) ) ) ) ) ; ; (if (= mithoeh 1) (progn (if (= sym "") (progn (command "-layer" "m" (strcat "H" lcode) "") (command "einfüge" "hkrz" pkt1 fkt "" richt) ) (command "-layer" "m" (strcat "H" sym) "") ) (if (= hset 0) (setq hset 1) (if (= hset 2) (setq hset 3) ) ) (setq txp1 (+ xxx (* willxo 1.12))) (setq txp2 (+ yyy (* willyo 1.12))) (setq txp (list txp1 txp2)) (command "text" txp hscala richt (rtos zzz 2 2)) ; ; --> die letzte Ziffer n bei (rtos zzz 2 n) bedeutet die Anzahl der Nachkommastellen ! ; ) ) ; ; (if (= einzel 1) (if (/= sym "") (progn ; ; SYMBOLCODES SETZEN ; (command "-layer" "m" sym "") ; (setq ix 0) ; (if (= sym "5") (setsym "X08")) ; DURCHLASS (if (= sym "6") (setsym "X10")) ; GRENZSTEIN (if (= sym "600") (setsym "X11")) ; GRENZBOLZEN (if (= sym "10") (setsym "X31")) ; NADELBAUM (if (= sym "11") (setsym "X32")) ; LAUBBAUM (if (= sym "12") (setsym "heckp")) ; HECKENPUNKT (if (= sym "121") (setsym "X34")) ; GEBÜSCH gemessen (if (= sym "21") (setsym "X61")) ; FAHRBAHNMITTE (if (= sym "30") (setsym "X30")) ; VERKEHRSZEICHEN feststehend (if (= sym "301") (setsym "X94")) ; HINWEISTAFEL (if (= sym "303") (setsym "X72")) ; HALTESTELLE Bus+Bahn (if (= sym "31") (setsym "X76")) ; AMPEL (if (= sym "312") (setsym "X96")) ; SCHRANKE (if (= sym "323") (setsym "X29")) ; STATIONSZEICHEN ; (if (= sym "37") ; ANSCHLAGSÄULE (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "X54") ) ) ; (if (= sym "41") (setsym "X21")) ; WASSERSCHIEBER (if (= sym "431") (setsym "X17")) ; ABWASSERSCHACHT rund (if (= sym "432") (setsym "X17")) ; ABWASSERSCHACHT rechteckig (if (= sym "434") (setsym "X17")) ; EINLAUFSCHACHT rechteckig (if (= sym "44") (setsym "X16")) ; EINLAUF mittig (if (= sym "442") (setsym "X16")) ; SEITENEINLAUF (if (= sym "45") (setsym "X19")) ; UNTERFLURHYDRANT (if (= sym "52") (setsym "X79")) ; BETONMAST (if (= sym "53") (setsym "X80")) ; HOLZMAST ; (if (= sym "54") ; KABELSCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "X18") ) ) (if (= sym "542") ; KABELSCHACHT LSA (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "X18") ) ) ; (if (= sym "55") ; MERKZEICHEN Elt (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "X15") ) ) (if (= sym "56") (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "X23") ; SCHALTKASTEN ) ) (if (= sym "57") (setsym "X77")) ; LATERNE ; (if (= sym "58") (setsym "X78")) ; RUFSÄULE ; (if (= sym "61") (setsym "planke")) ; LEITPLANKE (if (= sym "91") (setsym "X20")) ; GASSCHIEBER (if (= sym "98") (setsym "X98")) ; SONSTIGES (if (= sym "981") (setsym "X01")) ; GELÄNDEPUNKT ; (if (= sym "991") ; POLYGONPUNKT-ZIELPUNKT (progn (setsym "X09") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "99") ; POLYGONPUNKT-STANDPUNKT (progn (setsym "X99") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= ix 0) (progn (setq symricht richt) (setsym "X99") ) ) ) ) ) ) ) ; (setq zi (read-line fi)) ) (close fi) (setq offen 0) ) ) ) ) ) (progn (write-line " Kein Dateiname eingegeben ! ") (write-line "") (graphscr) ) ) ) ) ; ; LIMITEN ANPASSEN ; (setq minx (car (getvar "EXTMIN"))) (setq miny (cadr (getvar "EXTMIN"))) (setq maxx (car (getvar "EXTMAX"))) (setq maxy (cadr (getvar "EXTMAX"))) (setvar "LIMMIN" (list minx miny)) (setvar "LIMMAX" (list maxx maxy)) ; ; LÖSCHEN DER ALTEN GITTERKREUZE ; (setq asatz (ssget "X" '((8 . "GITTER")))) (if (/= asatz nil) (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (if (= (cdr (assoc 0 edefi)) "INSERT") (entdel (ssname asatz counter))) (setq counter (1+ counter)) ) (setq asatz nil) ) ) ; ; Setzen der neuen Gitterkreuze ; (if (= rasta 1) (if (> maxx minx) (progn (command "limiten" "aus") (if (= offen 2) (command "-layer" "t" "*" "ei" "*" "") (if (= mitgitter 1) (command "-layer" "t" "gitter" "")) ) ; (setq xuanz (fix (/ (- maxx minx) abst))) (setq yuanz (fix (/ (- maxy miny) abst))) (setq xmi (* abst (fix (/ minx abst)) 1.0)) (setq ymi (* abst (fix (/ miny abst)) 1.0)) ; (setq pt3 (list xmi ymi)) (command "-layer" "m" "gitter" "") (command "einfüge" "krz" pt3 fkt "" "") (command "reihe" (entlast) "" "r" (+ yuanz 2) (+ xuanz 2) abst abst) ) ) ) ; ; Wiederherstellen der Systemvariablen ; (if (= offen 2) (if (= hset 0) (command "-layer" "se" "0" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "*num" "") (command "-layer" "se" "0" "fr" "*num" "fr" "h*" "") ) ) ) ; (if (= hset 0) (command "-layer" "se" "0" "fr" "gitter" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "gitter" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "") (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "fr" "h*" "") ) ) ) ) ; (setq neusetz (getvar "clayer")) (if (/= gesetzt neusetz) (progn (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (= lname gesetzt) (progn (if (= (boole 1 flaggy 1) 1) (command "-layer" "t" lname "")) (command "-layer" "se" lname "") (setq zh nil) ) (setq zh (read-line fh)) ) ) (close fh) ) ) ) ) (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (if (/= zh nil) (progn (command "-layer") (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (/= gesetzt lname) (if (= (boole 1 flaggy 1) 1) (command "fr" lname) (command "t" lname) ) ) (setq zh (read-line fh)) ) (command "") ) ) (close fh) ) ) (command "DEL" "LAYER.TAB") (setvar "REGENMODE" 1) (command "zoom" "a") ; (setvar "DRAGMODE" save05) (setvar "REGENMODE" save06) (setvar "AUNITS" save01) (setvar "ANGBASE" save02) (setvar "ANGDIR" save03) (setvar "SPLINETYPE" save04) (setvar "OSMODE" save07) ; (setq rasta nil) (reset_err) ; ) ; ; ; ; ; (defun autosave () (command "sichern" "c:\\tmp\\sicher.dwg" "y") ; ) ; ; (defun c:scopy () (init_err) (autosave) (command "copy") (reset_err) (princ ) ) ; (setq fd (open "c:\\tmp\\sicher.dwg" "w")) (princ "" fd) (close fd) (princ) ; ; (princ ".") ; kart - AutoCAD - Befehl zum Einlesen ; von Linien und Symbolen aus Tachymeteraufnahme ; mit variabler Layerauswahl ; ; neue Code- und Blockdefinitionen (März 2001) ; ; aktuelle Variante ; ; (defun C:card1sym () ; (init_err) (textscr) (setq hset 0) ; (setq gesetzt (getvar "CLAYER")) (setq fh (open "LAYER.TAB" "w")) (setq mitgitter 0) (if (/= fh nil) (progn (setq edefi2 (tblnext "LAYER" "1")) (while (/= edefi2 nil) (setq lname (cdr (assoc 2 edefi2))) (if (= lname "GITTER") (setq mitgitter 1)) (while (< (strlen lname) 40) (setq lname (strcat lname " "))) (setq lflag (itoa (cdr (assoc 70 edefi2)))) (while (< (strlen lflag) 4) (setq lflag (strcat " " lflag))) (write-line (strcat lname lflag) fh) (setq edefi2 (tblnext "LAYER")) ) (close fh) ) ) ; (write-line "") (setq mst (getint "Maßstab 1 : XXXX <250> : ")) (if (= mst nil) (setq mst 250.0)) (write-line "") (setq abst (fix (/ mst 10))) (setq fkt (/ mst 714.28571)) (setq zusch (/ mst 750.0)) (setq hscala (/ mst 666.6667)) ; ; Sicherung der zu verändernden Systemvariablen ; (setq save01 (getvar "AUNITS")) (setq save02 (getvar "ANGBASE")) (setq save03 (getvar "ANGDIR")) (setq save04 (getvar "SPLINETYPE")) (setq save05 (getvar "DRAGMODE")) (setq save06 (getvar "REGENMODE")) (setq save07 (getvar "OSMODE")) ; ; Setzen der Variablen ; (setvar "AUNITS" 2) (setvar "ANGDIR" 1) (setvar "ANGBASE" (/ pi 2.0)) (setvar "SPLINETYPE" 6) (setvar "cmdecho" 0) (setvar "DRAGMODE" 0) (setvar "REGENMODE" 0) (setvar "OSMODE" 0) ; (setq richt (getreal "Textrichtung <0> : ")) (if (= richt nil) (setq richt 100.0) (setq richt (- 500.0 richt))) (if (>= richt 400.0) (setq richt (- richt 400.0))) (write-line "") ; ; Berechnung der Verschiebemaße für die Beschriftungen ; (setq willxo (* (sin (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willyo (* (cos (* (/ (- richt 12.0) 200.0) pi)) zusch)) (setq willxu (* (sin (* (/ (+ richt 12.0) 200.0) pi)) zusch)) (setq willyu (* (cos (* (/ (+ richt 12.0) 200.0) pi)) zusch)) ; (write-line "Bitte die Summe der gewünschten Eingabeoptionen angeben !") (write-line "") (write-line " 1 Einzelpunkte ") (write-line " 2 Linien ") (write-line " 4 Punktnummern ") (write-line " 8 Höhen ") (write-line "") (setq auswahl (getint "Ihre Eingabe <3> : ")) (if (= auswahl nil) (setq auswahl 3)) (write-line "") ; (write-line "Bitte wählen Sie aus :") (write-line "") (write-line " 1 mit Raster setzen") (write-line " 2 ohne Raster setzen") (write-line "") (setq rasta (getint "Ihre Eingabe <2> : ")) (write-line "") (IF (/= rasta 2) (setq rasta 2)) ; ; (setq offen 2) (if (/= auswahl 0) (progn (setq einzel (boole 1 auswahl 1)) (setq linien (boole 1 auswahl 2)) (setq nummern (boole 1 auswahl 4)) (setq hoehen (boole 1 auswahl 8)) ; (command "stil" "normal" "romans" "0.0" "1.0" "" "" "" "") (command "farbe" "vonlayer") (setq fnm (getstring "Lesen von Datei : ")) (write-line "") ; (if (/= fnm "") (progn ; (setq fi (open fnm "r")) (if (= fi nil) (progn (write-line (strcat " Datei " fnm " wurde nicht gefunden ! ")) (write-line "") (graphscr) ) (progn ; ; Einlesen der Linien (Höhenschichtlinien als Polylinie) ; (setq offen 1) (if (= linien 2) (progn (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") (setq polylin 0) (setq altlnum 0) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (if (/= (substr zi 66 3) " 0") (progn ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq lnum (atoi (substr zi 53 4))) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq bog (atoi (substr zi 65 1))) (setq pkt1 (list xxx yyy)) ; ; (if (/= lnum 0) (progn (if (= bog 1) ; BOGENANFANG (setq banfpkt pkt1) ) ; (if (= lnum altlnum) (progn ; (if (< bog 2) (progn (if (= polylin 0) (command "linie" pkt2 pkt1 "") (progn (if (= larc 1) (command "li")) (setq larc 0) (command pkt1) ) ) ) ) ; (if (>= bog 3) (progn (if (= lcode "199") (progn (setq vfkt (* (distance banfpkt pkt1) 0.5)) (setq symricht (- 400.0 (* (/ (angle banfpkt pkt1) pi) 200.0))) (if (>= symricht 400.0) (setq symricht (- symricht 400.0))) (command "einfüge" "zaun1" pkt2 vfkt "" symricht) ) (progn (if (= polylin 0) (command "bogen" banfpkt pkt2 pkt1) (progn (if (= larc 0) (command "k")) (command "p" pkt2 pkt1) (setq larc 1) ) ) (if (= bog 4) (setq banfpkt pkt1)) ) ) ) ) ; ) (progn (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) (command "-layer" "m" lcode "") (setq polylin 0) (setq larc 0) (if (= lcode "100") (setq polylin 1)) (if (= lcode "101") (setq polylin 1)) (if (= polylin 1) (command "plinie" pkt1)) ) ) ) ) ; ; (setq altlnum lnum) (setq pkt2 pkt1) ) ) ) ) (setq zi (read-line fi)) ) (close fi) (setq offen 0) (if (= polylin 1) (progn (command "") (setq plast (entlast)) (command "pedit" plast "k" "x") ) ) ) ) ; ; Einlesen der Einzelpunkte, Höhen und Nummern ; (if (/= auswahl 2) (progn (if (= offen 0) (progn (setq fi (open fnm "r")) (setq offen 1) ) (command "raster" "au" "zoom" "a" "-layer" "t" "*" "ei" "*" "") ) (setq zi (read-line fi)) (while zi (if (/= zi "") (progn (if (< (strlen zi) 56) (setq zi (strcat (substr zi 1 52) " 0"))) (if (< (strlen zi) 62) (setq zi (strcat (substr zi 1 56) " 98"))) (if (< (strlen zi) 68) (setq zi (strcat (substr zi 1 62) " 0"))) ; (setq pnr (substr zi 7 13)) (setq ende 1) (while ende (if (= (substr pnr 1 1) " ") (setq pnr (substr pnr 2 (1- (strlen pnr)))) (setq ende nil) ) ) ; (setq xxx (atof (substr zi 20 12))) (setq yyy (atof (substr zi 32 12))) (setq zzz (atof (substr zi 44 9))) ; (setq sym (substr zi 60 3)) (setq ende 1) (while ende (if (= (substr sym 1 1) " ") (setq sym (substr sym 2 (1- (strlen sym)))) (setq ende nil) ) ) ; (if (> (strlen zi) 68) (setq symricht (atof (substr zi 69 10))) (setq symricht 0.0) ) ; (setq lcode (substr zi 66 3)) (setq ende 1) (while ende (if (= (substr lcode 1 1) " ") (setq lcode (substr lcode 2 (1- (strlen lcode)))) (setq ende nil) ) ) (if (= lcode "") (setq lcode "0")) ; (setq mitnum 0) (setq xnum 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xnum 0)) ) (if (= nummern 4) (if (/= pnr "") (if (= xnum 1) (if (= auswahl 4) (setq mitnum 1) (progn (if (= linien 2) (setq mitnum 1)) (if (/= sym "") (if (= einzel 1) (setq mitnum 1)) ) ) ) ) ) ) ; (setq mithoeh 0) (setq xhoeh 1) (if (= (strlen pnr) 5) (if (= (substr pnr 1 1) "6") (setq xhoeh 0)) ) (if (= hoehen 8) (if (/= lcode "199") (if (= xhoeh 1) (if (/= zzz 0.0) (if (= auswahl 8) (setq mithoeh 1) (progn (if (= linien 2) (setq mithoeh 1)) (if (/= sym "") (if (= einzel 1) (setq mithoeh 1)) ) ) ) ) ) ) ) ; (setq pkt1 (list xxx yyy)) ; ; ; (if (= mitnum 1) (progn (if (= hset 0) (setq hset 2) (if (= hset 1) (setq hset 3) ) ) (if (/= sym "") (progn (setq numlay "einzelnum") (if (= sym "6") (setq numlay "grenznum")) (if (= sym "7") (setq numlay "grenznum")) (if (= sym "600") (setq numlay "grenznum")) (if (= sym "601") (setq numlay "grenznum")) (if (= (substr sym 1 2) "43") (setq numlay "snum")) (command "-layer" "m" numlay "") ) (progn (command "-layer" "m" "krznum" "" "einfüge" "nkrz" pkt1 fkt "" richt) (setq numlay "sonstnum") (if (= lcode "13") (setq numlay "gebnum")) (if (= lcode "131") (setq numlay "gebnum")) (if (= lcode "2") (setq numlay "boeschnum")) (if (= lcode "3") (setq numlay "boeschnum")) (if (= lcode "4") (setq numlay "boeschnum")) (if (= lcode "21") (setq numlay "stranum")) (if (= lcode "22") (setq numlay "stranum")) (if (= lcode "23") (setq numlay "stranum")) (if (= lcode "24") (setq numlay "stranum")) (if (= lcode "25") (setq numlay "stranum")) (if (= lcode "26") (setq numlay "stranum")) (if (= lcode "27") (setq numlay "stranum")) (if (= lcode "28") (setq numlay "stranum")) (if (= lcode "6") (setq numlay "grenznum")) (if (= lcode "7") (setq numlay "grenznum")) (if (= lcode "600") (setq numlay "grenznum")) (if (= lcode "601") (setq numlay "grenznum")) (command "-layer" "m" numlay "") ) ) (if (and (/= sym "99") (/= sym "991") (/= sym "8")) (progn (setq txp1 (+ xxx (* willxu 1.5))) (setq txp2 (+ yyy (* willyu 1.5))) (setq txp (list txp1 txp2)) (command "text" "p" "ol" txp (* zusch 1.8) richt pnr) ) ) ) ) ; ; (if (= mithoeh 1) (progn (if (= sym "") (progn (command "-layer" "m" (strcat "H" lcode) "") (command "einfüge" "hkrz" pkt1 fkt "" richt) ) (command "-layer" "m" (strcat "H" sym) "") ) (if (= hset 0) (setq hset 1) (if (= hset 2) (setq hset 3) ) ) (setq txp1 (+ xxx (* willxo 1.12))) (setq txp2 (+ yyy (* willyo 1.12))) (setq txp (list txp1 txp2)) (command "text" txp hscala richt (rtos zzz 2 2)) ; ; --> die letzte Ziffer n bei (rtos zzz 2 n) bedeutet die Anzahl der Nachkommastellen ! ; ) ) ; ; (if (= einzel 1) (if (/= sym "") (progn ; ; SYMBOLCODES SETZEN ; (command "-layer" "m" sym "") ; (setq ix 0) ; (if (= sym "1") ; Heizungsschacht (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB1321") ) ) ; (if (= sym "2") (setsym "SYMB0001")) ; GELÄNDEPUNKT (if (= sym "3") (setsym "SYMB0001")) ; GELÄNDEPUNKT (if (= sym "4") (setsym "SYMB0001")) ; GELÄNDEPUNKT (if (= sym "5") (setsym "SYMB1416")) ; DURCHLASS (if (= sym "6") (setsym "SYMB0002")) ; GRENZPUNKT aufgemessen (if (= sym "7") (setsym "SYMB0566")) ; GRENZPUNKT nicht aufgemessen (if (= sym "7A") (setsym "SYMB0005")) ; GRENZPUNKT übern. Vermbüro (if (= sym "701") (setsym "SYMB0001")) ; GRENZPUNKT nicht abgemarkt (if (= sym "702") (setsym "SYMB0007")) ; GRENZPUNKT übern. VA/ÖBVI (if (= sym "8") ; TP (progn (setsym "SYMB0005") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) (if (= sym "9") (setsym "SYMB1313")) ; FERNMELDESCHACHT ; (if (= sym "10") (setsym "SYMB1124")) ; NADELBAUM (if (= sym "102") (setsym "SYMB1466")) ; FELS (if (= sym "10A") (setsym "SYMB1150")) ; EIBE (if (= sym "10B") (setsym "SYMB1151")) ; FICHTE (if (= sym "10C") (setsym "SYMB1152")) ; KIEFER (if (= sym "10D") (setsym "SYMB1153")) ; LÄRCHE (if (= sym "10E") (setsym "SYMB1154")) ; LEBENSBAUM (if (= sym "10F") (setsym "SYMB1155")) ; TANNE (if (= sym "10G") (setsym "SYMB1156")) ; WACHOLDER (if (= sym "10H") (setsym "SYMB1157")) ; ZYPRESSE (if (= sym "11") (setsym "SYMB1122")) ; LAUBBAUM (if (= sym "111") (setsym "SYMB1123")) ; OBSTBAUM (if (= sym "112") (setsym "SYMB1304")) ; OBSTPLANTAGE (if (= sym "11A") (setsym "SYMB1140")) ; AHORN (if (= sym "11B") (setsym "SYMB1141")) ; BIRKE (if (= sym "11C") (setsym "SYMB1142")) ; BUCHE (if (= sym "11D") (setsym "SYMB1143")) ; EICHE (if (= sym "11E") (setsym "SYMB1144")) ; ESCHE (if (= sym "11F") (setsym "SYMB1145")) ; KASTANIE (if (= sym "11G") (setsym "SYMB1146")) ; LINDE (if (= sym "11H") (setsym "SYMB1147")) ; PAPPEL (if (= sym "11I") (setsym "SYMB1148")) ; WEIDE (if (= sym "11J") (setsym "SYMB1326")) ; LAUBBAUM planerischer Bedeutung (if (= sym "11K") (setsym "SYMB7777")) ; EBERESCHE (if (= sym "11L") (setsym "SYMB8888")) ; ERLE (if (= sym "11M") (setsym "SYMB9999")) ; ROBINIE (if (= sym "121") (setsym "SYMB1256")) ; GEBÜSCH ; ; (if (= sym "12") (setsym "heckp")) ; HECKENPUNKT ; (if (= sym "138") (setsym "SYMB1312")) ; TANKSTELLE (if (= sym "139") (setsym "SYMB0021")) ; Stütze Überdachung (if (= sym "15") ; ZAUNSSÄULE (progn (setq xfkt fkt) (setq fkt (* fkt 0.5)) (setsym "SYMB1220") (setq fkt xfkt) ) ) (if (= sym "161") (setsym "SYMB0563")) ; TOR (if (= sym "171") (setsym "SYMB1303")) ; TÜR (if (= sym "182") (setsym "SYMB0606")) ; OK SCHWELLE (if (= sym "183") (setsym "SYMB0001")) ; OK EINGANGSSTUFE (if (= sym "19") (setsym "SYMB1109")) ; HÖHENFESTPUNKT / PB (if (= sym "191") (setsym "SYMB1109")) ; HÖHENFESTPUNKT / MB (if (= sym "20") (setsym "SYMB0031")) ; NETZKNOTENPUNKT (if (= sym "21") (setsym "SYMB0001")) ; FAHRBAHNMITTE (if (= sym "282") (setsym "PFEIL-HR")) ; PFEIL HALBRECHTS (if (= sym "30") (setsym "SYMB1269")) ; VERKEHRSZEICHEN feststehend (if (= sym "301") (setsym "SYMB0564")) ; WEGWEISER (if (= sym "302") (setsym "SYMB1269")) ; STRASSENNAMENSCHILD (if (= sym "303") (setsym "SYMB0636")) ; HALTESTELLE Bus+Bahn (if (= sym "304") (setsym "SYMB1300")) ; WERBETAFEL (if (= sym "306") (setsym "SYMB1318")) ; SCHILDERPFAHL (if (= sym "307") (setsym "SYMB1320")) ; LICHTZEICHENBRÜCKE (if (= sym "308") (setsym "SYMB1263")) ; VZ §41 (if (= sym "309") (setsym "SYMB1249")) ; VZ §42 (if (= sym "31") (setsym "SYMB1273")) ; AMPEL (if (= sym "310") (setsym "SYMB1324")) ; WINDRAD (if (= sym "311") (setsym "SYMB0682")) ; SIGNAL (if (= sym "312") (setsym "SYMB0555")) ; SCHRANKE (if (= sym "321") (setsym "SYMB1225")) ; KILOMETERSTEIN Straße (if (= sym "322") (setsym "SYMB1225")) ; KILOMETERSTEIN Eisenbahn (if (= sym "323") (setsym "SYMB1317")) ; STATIONSZEICHEN (if (= sym "324") (setsym "SYMB0592")) ; ORTSDURCHFAHRTSSTEIN (if (= sym "33") (setsym "SYMB1269")) ; ORTSDURCHFAHRTSSCHILD (if (= sym "35") (setsym "SYMB1308")) ; ROHRSOHLE (if (= sym "36") (setsym "SYMB1314")) ; FAHNENMAST ; ; (if (= sym "37") ; ANSCHLAGSÄULE ; (progn ; (while (> symricht 50.0) (setq symricht (- symricht 100.0))) ; (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) ; (setsym "ans") ; ) ; ) ; (if (= sym "381") (setsym "SYMB1327")) ; SCHACHT rund (if (= sym "38") (setsym "SYMB1205")) ; SCHACHT rechteckig ; (if (= sym "382") (setsym "rst")) ; ROHRSTUTZEN ; (if (= sym "39") (setsym "SYMB1248")) ; DENKMAL ; (if (= sym "40") (setsym "br1")) ; SPRINGBRUNNEN (if (= sym "41") (setsym "SYMB1119")) ; WASSERSCHIEBER ; (if (= sym "411") (setsym "as")) ; ABWASSERSCHIEBER (if (= sym "42") (setsym "SYMB1247")) ; ÜBERFLURHYDRANT (if (= sym "431") (setsym "SYMB1117")) ; ABWASSERSCHACHT rund (if (= sym "432") (setsym "SYMB1205")) ; ABWASSERSCHACHT rechteckig (if (= sym "433") (setsym "SYMB1093")) ; EINLAUFSCHACHT rund (if (= sym "434") (setsym "SYMB1205")) ; EINLAUFSCHACHT rechteckig (if (= sym "436") (setsym "SYMB1203")) ; LICHTSCHACHT (if (= sym "44") (setsym "SYMB1239")) ; EINLAUF mittig (if (= sym "441") (setsym "SYMB1230")) ; EINLAUF am Rand (if (= sym "442") (setsym "SYMB1239")) ; SEITENEINLAUF (if (= sym "45") (setsym "SYMB1405")) ; UNTERFLURHYDRANT (if (= sym "50") (setsym "SYMB1237")) ; STAHLGITTERMAST (if (= sym "501") (setsym "SYMB1323")) ; FUNKMAST (if (= sym "51") (setsym "SYMB1083")) ; STAHLROHRMAST (if (= sym "52") (setsym "SYMB1080")) ; BETONMAST (if (= sym "53") (setsym "SYMB1077")) ; HOLZMAST (if (= sym "507") (setsym "SYMB1070")) ; STAHLGITTERM: mit Leuchte (if (= sym "517") (setsym "SYMB1070")) ; STAHLROHRM: mit Leuchte (if (= sym "527") (setsym "SYMB1070")) ; BETONM: mit Leuchte (if (= sym "521") (setsym "SYMB1100")) ; DOPPELMAST (if (= sym "531") (setsym "SYMB0550")) ; A-MAST (if (= sym "537") (setsym "SYMB1070")) ; HOLZM: mit Leuchte ; (if (= sym "54") ; KABELSCHACHT (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB1233") ) ) (if (= sym "541") ; KABELSCHACHT doppelt (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB1233") ) ) ; ; (if (= sym "542") (setsym "kbm")) ; KABELMUFFE ; (if (= sym "55") ; MERKZEICHEN Elt (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0556") ) ) (if (= sym "552") ; MERKZEICHEN Post (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0558") ) ) (if (= sym "553") ; MERKZEICHEN Fernwärme (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0559") ) ) (if (= sym "56") (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0565") ; SCHALTKASTEN ) ) (if (= sym "561") (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0565") ; SCHALTKASTEN ) ) (if (= sym "562") (progn (if (>= symricht 100.0) (if (< symricht 300.0) (setq symricht (- symricht 200.0)) ) ) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0565") ; SCHALTKASTEN ) ) (if (= sym "57") (setsym "SYMB1070")) ; LATERNE (if (= sym "571") (setsym "SYMB1270")) ; GASLATERNE ; ; (if (= sym "58") (setsym "SYMB0711")) ; RUFSÄULE ; (progn ; (while (> symricht 50.0) (setq symricht (- symricht 100.0))) ; (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) ; (setsym "rufs") ; ) ; ) ; ; (if (= sym "595") (setsym "ltg")) ; UK Elektroleitung ; (if (= sym "596") (setsym "fd")) ; UF Fahrdraht ; (if (= sym "60") (setsym "SYMB0011")) ; LEITUNGSPUNKT Freiltg. Strom (if (= sym "601") (setsym "SYMB0011")) ; LEITUNGSPUNKT Freiltg. FM ; (if (= sym "61") (setsym "planke")) ; LEITPLANKE ; (if (= sym "622") (setsym "spf1")) ; SPERRPFOSTEN ; (if (= sym "623") (setsym "spf2")) ; HšLSE FšR SPERRPFOSTEN (if (= sym "64") (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0557") ; MERKSÄULE Gas ) ) ; (if (= sym "65") (setsym "SYMB1309")) ; PARKPLATZ ; (if (= sym "651") (setsym "SYMB1319")) ; PARKUHR (if (= sym "652") (setsym "SYMB0645")) ; Fahrscheinautomat (if (= sym "702") (setsym "SYMB1077")) ; GRENZPUNKT übernommen (if (= sym "703") (setsym "SYMB0569")) ; GRENZPUNKT nicht aktuell (if (= sym "70") (setsym "SYMB0603")) ; POLLER (if (= sym "71") (setsym "SYMB0001")) ; SOHLE (if (= sym "74") (setsym "SYMB1412")) ; TRANSFORMATORENHÄUSCHEN ; (if (= sym "76") (setsym "oel")) ; OELABSCHEIDER ; (if (= sym "774") (setsym "SYMB0001")) ; PFEILER Achse (if (= sym "775") (setsym "SYMB0001")) ; Pfeiler Ecke (if (= sym "776") (setsym "SYMB1328")) ; LICHTE HÖHE (if (= sym "79") (setsym "SYMB1311")) ; TELEFONZELLE (if (= sym "80") (setsym "SYMB0553")) ; BRUNNEN (if (= sym "801") (setsym "SYMB0552")) ; QUELLE (if (= sym "802") (setsym "SYMB0554")) ; PUMPE (if (= sym "82") (setsym "SYMB1415")) ; WASSERSPIEGEL (if (= sym "871") (setsym "SYMB1005")) ; LAUBWALD (if (= sym "872") (setsym "SYMB1010")) ; NADELWALD (if (= sym "873") (setsym "SYMB1011")) ; MISCHWALD (if (= sym "874") (setsym "SYMB1256")) ; GEBÜSCH ; (if (= sym "89") (setsym "klgr")) ; KLŽRGRUBE (if (= sym "90") (progn (while (> symricht 50.0) (setq symricht (- symricht 100.0))) (if (< symricht 0.0) (setq symricht (+ symricht 400.0))) (setsym "SYMB0568") ; MERKSÄULE Wasser ) ) ; (if (= sym "901") (setsym "luf")) ; ENTLÜFTUNG (if (= sym "91") (setsym "SYMB1117")) ; GASSCHIEBER ; (if (= sym "921") (setsym "bohr1")) ; KERNBOHRPUNKT ; (if (= sym "922") (setsym "bohr2")) ; BOHRPUNKT (if (= sym "923") (setsym "SYMB1310")) ; PEGELBOHRPUNKT ; (if (= sym "923") (setsym "bohr3")) ; PEGELBOHRPUNKT ; (if (= sym "93") (setsym "ok")) ; OBERKANTE ; (if (= sym "931") (setsym "okfeg")) ; OBERKANTE FB EG ; (if (= sym "932") (setsym "okfkg")) ; OBERKANTE FB KG (if (= sym "933") (setsym "SYMB0606")) ; OBERKANTE EINGANG (if (= sym "934") (setsym "SYMB6000")) ; OBERKANTE KELLERFENSTER ; (if (= sym "94") (setsym "uk")) ; UNTERKANTE (if (= sym "95") (setsym "SYMB0063")) ; FALLROHR ; (if (= sym "97") (setsym "flmst")) ; FLUTLICHTMAST (if (= sym "98") (setsym "SYMB0001")) ; GELÄNDEPUNKT (if (= sym "980") (setsym "SYMB1305")) ; ACKER (if (= sym "981") (setsym "SYMB1036")) ; WIESE (if (= sym "982") (setsym "SYMB1015")) ; MOOR (if (= sym "983") (setsym "SYMB1016")) ; SCHILF (if (= sym "984") (setsym "SYMB1012")) ; PARKANLAGE (if (= sym "985") (setsym "SYMB1306")) ; GARTENANLAGE (if (= sym "986") (setsym "SYMB1435")) ; CAMPINGPLATZ ; (if (= sym "984") (setsym "SYMB0001")) ; UK Brücke (Durchfahrtsh"he) ; (if (= sym "985") (setsym "SYMB0007")) ; Blumenkübel 1.0 x 1.0 ; ; (if (= sym "991") ; AP (progn (setsym "SYMB0002") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= sym "99") ; POLYGONPUNKT (progn (setsym "SYMB0002") (command "-layer" "m" sym "") (setq txp (list (+ xxx (* willxu 1.3)) (+ yyy (* willyu 1.3)))) (command "text" "p" "ol" txp (* zusch 1.75) richt pnr) ) ) ; (if (= ix 0) (progn (setq symricht richt) (setsym "SYMB0011") ) ) ) ) ) ) ) ; (setq zi (read-line fi)) ) (close fi) (setq offen 0) ) ) ) ) ) (progn (write-line " Kein Dateiname eingegeben ! ") (write-line "") (graphscr) ) ) ) ) ; ; LIMITEN ANPASSEN ; (setq minx (car (getvar "EXTMIN"))) (setq miny (cadr (getvar "EXTMIN"))) (setq maxx (car (getvar "EXTMAX"))) (setq maxy (cadr (getvar "EXTMAX"))) (setvar "LIMMIN" (list minx miny)) (setvar "LIMMAX" (list maxx maxy)) ; ; LÖSCHEN DER ALTEN GITTERKREUZE ; (setq asatz (ssget "X" '((8 . "GITTER")))) (if (/= asatz nil) (progn (setq asatzlen (sslength asatz)) (setq counter 0) (while (< counter asatzlen) (setq edefi (entget (setq elent (ssname asatz counter)))) (if (= (cdr (assoc 0 edefi)) "INSERT") (entdel (ssname asatz counter))) (setq counter (1+ counter)) ) (setq asatz nil) ) ) ; ; Setzen der neuen Gitterkreuze ; (if (= rasta 1) (if (> maxx minx) (progn (command "limiten" "aus") (if (= offen 2) (command "-layer" "t" "*" "ei" "*" "") (if (= mitgitter 1) (command "-layer" "t" "gitter" "")) ) ; (setq xuanz (fix (/ (- maxx minx) abst))) (setq yuanz (fix (/ (- maxy miny) abst))) (setq xmi (* abst (fix (/ minx abst)) 1.0)) (setq ymi (* abst (fix (/ miny abst)) 1.0)) ; (setq pt3 (list xmi ymi)) (command "-layer" "m" "gitter" "") (command "einfüge" "krz" pt3 fkt "" "") (command "reihe" (entlast) "" "r" (+ yuanz 2) (+ xuanz 2) abst abst) ) ) ) ; ; Wiederherstellen der Systemvariablen ; (if (= offen 2) (if (= hset 0) (command "-layer" "se" "0" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "*num" "") (command "-layer" "se" "0" "fr" "*num" "fr" "h*" "") ) ) ) ; (if (= hset 0) (command "-layer" "se" "0" "fr" "gitter" "") (if (= hset 1) (command "-layer" "se" "0" "fr" "gitter" "fr" "h*" "") (if (= hset 2) (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "") (command "-layer" "se" "0" "fr" "gitter" "fr" "*num" "fr" "h*" "") ) ) ) ) ; (setq neusetz (getvar "clayer")) (if (/= gesetzt neusetz) (progn (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (= lname gesetzt) (progn (if (= (boole 1 flaggy 1) 1) (command "-layer" "t" lname "")) (command "-layer" "se" lname "") (setq zh nil) ) (setq zh (read-line fh)) ) ) (close fh) ) ) ) ) (setq fh (open "LAYER.TAB" "r")) (if (/= fh nil) (progn (setq zh (read-line fh)) (if (/= zh nil) (progn (command "-layer") (while zh (setq lname (substr zh 1 40)) (while (= (substr lname (strlen lname) 1) " ") (setq lname (substr lname 1 (- (strlen lname) 1)))) (setq flaggy (atoi (substr zh 41 4))) (if (/= gesetzt lname) (if (= (boole 1 flaggy 1) 1) (command "fr" lname) (command "t" lname) ) ) (setq zh (read-line fh)) ) (command "") ) ) (close fh) ) ) (command "DEL" "LAYER.TAB") (setvar "REGENMODE" 1) (command "zoom" "a") ; (setvar "DRAGMODE" save05) (setvar "REGENMODE" save06) (setvar "AUNITS" save01) (setvar "ANGBASE" save02) (setvar "ANGDIR" save03) (setvar "SPLINETYPE" save04) (setvar "OSMODE" save07) ; (setq rasta nil) (reset_err) ; ) ; ; ; ; ; (defun autosave () (command "sichern" "c:\\tmp\\sicher.dwg" "y") ; ) ; ; (defun c:scopy () (init_err) (autosave) (command "copy") (reset_err) (princ ) ) ; (setq fd (open "c:\\tmp\\sicher.dwg" "w")) (princ "" fd) (close fd) (princ) ; ; (princ ".")