; -------------------------------------------------------------- ; Positionsnummerzeichnen AW 20.5.93 ; Anpassung am 16.10.2006 ; SPS ID's eintragen - Sept. 2007 ; -------------------------------------------------------------- (defun Dbox (/ Dat) (setq Dat (load_dialog (strcat lw "/acadsst/menu/position.DCL"))) (if (not (new_dialog "position" Dat)) (exit)) (set_tile "EBE" m_EBE) (set_tile "WASTUN" m_WASTUN) (set_tile "FAKT" m_FAKT) (set_tile "STKLI" m_STKLI) (set_tile "STKLI_B" m_STKLI_B) (set_tile "FAHNE" m_FAHNE) (set_tile "UMRAND" m_UMRAND) (action_tile "accept" "(SetPara) (done_dialog)") (action_tile "cancel" "(exit) (done_dialog)") (start_dialog) (unload_dialog Dat) ) (defun SetPara () (setq m_EBE (get_tile "EBE")) (setq m_WASTUN (get_tile "WASTUN")) (setq m_FAKT (get_tile "FAKT")) (setq m_STKLI (get_tile "STKLI")) (setq m_STKLI_B (get_tile "STKLI_B")) (setq m_FAHNE (get_tile "FAHNE")) (setq m_UMRAND (get_tile "UMRAND")) (setq EBENE (atoi (substr m_EBE 5 1))) (setq MIT-AEND (atoi (substr m_WASTUN 8 1))) (setq FAKTO (atof m_FAKT)) ) ;-------------------------------------------------------------------- ; Positionsnummer einfügen ;-------------------------------------------------------------------- (defun posfahne() (Setq X (Getfiled "Auswahl Positionierdatei" (strcat "h:" "/daten/projekte/") "pos" 4 )) (If (/= X "") (Setq EFNAM X) ) (Setq EFPNT (Open EFNAM "r")) (If (= EFPNT nil) (alert (strcat "Die Datei " EFNAM " kann nicht ge”ffnet werden!")) (Progn (Setq CRNTL (Read-line EFPNT)) ; (Setq CRNTL (Read-line EFPNT)) ;damit wird die 1.Zeile bersprungen! (While CRNTL (if CRNTL (princ (strcat CRNTL "\n")) ) (setq POSNR (atoi (substr CRNTL 2 5))) (setq ADRESSE (substr CRNTL 8 30)) (setq SLEN 0) (setq KONTR-CHAR (substr ADRESSE 1 1)) (setq zaehler 1) (while (/= (ascii KONTR-CHAR) 32) (setq SLEN (+ SLEN 1)) (setq zaehler (+ zaehler 1)) (setq KONTR-CHAR (substr ADRESSE zaehler 1)) ) (setq ADRESSE (substr CRNTL 8 SLEN)) (setq POS-X (atof (substr CRNTL 39 11))) (setq POS-Y (atof (substr CRNTL 51 11))) (setq POS-Z (atof (substr CRNTL 63 11))) (setq PT0 (list POS-X POS-Y POS-Z)) (setq PT1 (list (+ POS-X (* FAKTO 100)) (+ POS-Y (* FAKTO 150)) POS-Z)) (setq PT2 (list (+ (car PT1) (* FAKTO 250)) (cadr PT1) (caddr PT1))) (setq PT3 (list (car PT2) (+ (cadr PT2) (* FAKTO 125)) (caddr PT1))) (setq PT4 (list (car PT1) (cadr PT3) (caddr PT1))) (setq PT5 (list (+ POS-X (* FAKTO 125)) (+ POS-Y (* FAKTO 175)) POS-Z)) (setq PT6 (list (+ (car PT1) (* FAKTO 125)) (+ (cadr PT1) (* FAKTO 68)) (caddr PT1))) (if (= m_UMRAND "UMRAND_1") (progn ; (command "_pline" PT0 PT1 PT2 PT3 PT4 PT1 "") (command "_pline" PT0 "_w" "0" "0" PT1 "") ; diese Linie wiird nicht zum Block hinugefügt (command "_pline" PT1 PT2 PT3 PT4 PT1 "") (setq auswahl-satz nil) (setq auswahl-satz (ssget "_L")) ) ) (if (= m_UMRAND "UMRAND_2") (progn (command "_line" PT0 PT1 "") (setq auswahl-satz nil) (setq auswahl-satz (ssget "_L")) (command "_circle" PT6 (* FAKTO 153)) (ssadd (entlast) auswahl-satz) ) ) (if (= m_UMRAND "UMRAND_3") ; for Automation (progn (setq POS-X (- POS-X 15)) (setq POS-Y (- POS-Y 15)) (setq PT0 (list POS-X POS-Y POS-Z)) (setq PT5 (list (- POS-X (* FAKTO 225)) (+ POS-Y (* FAKTO 25)) POS-Z)) (setq PT1 (list (- POS-X (* FAKTO 250)) POS-Y POS-Z)) (setq PT2 (list (car PT1) (+ (cadr PT1) (* FAKTO 150)) (caddr PT1))) (setq PT3 (list (car PT0) (+ (cadr PT0) (* FAKTO 150)) (caddr PT1))) (command "_pline" PT0 "_w" "0" "0" PT1 PT2 PT3 PT0 "") (setq auswahl-satz nil) (setq auswahl-satz (ssget "_L")) ) ) (command "_text" PT5 (rtos (* FAKTO 75)) "0" (itoa POSNR)) (ssadd (entlast) auswahl-satz) (block-op PT0 "0" auswahl-satz) (setq auswahl-satz nil) (if (and (/= ADRESSE nil) (= MIT-AEND 2)) (suchen-aendern ADRESSE "POSITION" (itoa POSNR) 0) ) (Setq CRNTL (Read-line EFPNT)) ) (alert "Die Zeichnung ist positioniert !") (Close EFPNT) ) ) (princ) ) ;------------------------------------------ ; Stuecliste einfuegen 22.1.94 AW ;------------------------------------------ (Defun stcklimp () (If (/= X "") (Setq EFNAM X) ) (Setq EFPNT (Open EFNAM "r")) (If (= EFPNT nil) (alert (Strcat "Datei kann " EFNAM " nicht geöffnet werden!")) (Progn (Setq CRNTL (Read-line EFPNT)) ; (Setq CRNTL (Read-line EFPNT)) (setq TSIZE (* FAKTO 100) LSPACE (* FAKTO 200)) (initget (+ 1 2 4)) (setq P1 (getpoint "\nObere-linke Ecke der Stückliste antippen: ")) (Setq P11 (List (- (Car P1) (* FAKTO 100)) (+ (Cadr P1) (* FAKTO 250)))) (Setq P12 (List (+ (Car P1) (* FAKTO 9000)) (+ (Cadr P1) (* FAKTO 250)))) (command "_line" P11 P12 (list (car P12) (+ (cadr P12) (* FAKTO 350))) (list (car P11) (+ (cadr P11) (* FAKTO 350))) P11 "") (Setq P91 (List (+ (Car P11) (* FAKTO 400)) (+ (Cadr P11) (* FAKTO 100)))) (Setq P92 (List (+ (Car P11) (* FAKTO 800)) (+ (Cadr P11) (* FAKTO 100)))) (Setq P93 (List (+ (Car P11) (* FAKTO 1450)) (+ (Cadr P11) (* FAKTO 100)))) (Setq P94 (List (+ (Car P11) (* FAKTO 2050)) (+ (Cadr P11) (* FAKTO 100)))) (Setq P95 (List (+ (Car P11) (* FAKTO 3250)) (+ (Cadr P11) (* FAKTO 100)))) (Command "_Text" P91 TSIZE 0 "POS") (Command "_Text" P92 TSIZE 0 "MENGE") (Command "_Text" P93 TSIZE 0 "LÄNGE") (Command "_Text" P94 TSIZE 0 "ARTIKEL-NR") (Command "_Text" P95 TSIZE 0 "BEZEICHNUNG") (While CRNTL (setq kette1 (substr crntl 1 6)) ;POSITION (setq kette2 (substr crntl 7 7)) ;MENGE (setq kette3 (substr crntl 14 9)) ;MASS (setq kette4 (substr crntl 23 10)) ;ARTINR (setq kette5 (substr crntl 33 60)) ;BEZEICHNUNG (Setq P2 (List (+ (Car P1) (* FAKTO 400)) (Cadr P1))) (Setq P3 (List (+ (Car P1) (* FAKTO 1000)) (Cadr P1))) (Setq P4 (List (+ (Car P1) (* FAKTO 1900)) (Cadr P1))) (Setq P5 (List (+ (Car P1) (* FAKTO 3000)) (Cadr P1))) (Setq P6 (List (+ (Car P1) (* FAKTO 9000)) (Cadr P1))) (Command "_Text" P1 TSIZE 0 kette1) (Command "_Text" P2 TSIZE 0 kette2) (Command "_Text" P3 TSIZE 0 kette3) (Command "_Text" P4 TSIZE 0 kette4) (Command "_Text" P5 TSIZE 0 kette5) (command "_line" (list (- (car P1) (* FAKTO 100)) (- (cadr P1) (* FAKTO 50))) (list (car P6) (- (cadr P6) (* FAKTO 50))) "") (Setq P1 (List (Car P1) (- (Cadr P1) LSPACE))) (Setq CRNTL (Read-line EFPNT)) ) (Close EFPNT) (command "_line" P11 P12 (list (+ (car P1) (* FAKTO 9000)) (- (cadr P1) (* FAKTO 50))) (list (- (car P1) (* FAKTO 100)) (- (cadr P1) (* FAKTO 50))) P11 "") ) ) (Princ) ) ;----------------------------------------------------------------------------------------------------------------- (defun c:position ( / CRNTL EFPNT EFNAM EBE WASTUN FAKT FAKTO MIT-AEND EBENE UMRAND STKLI FAHNE ADRESSE P1 P2 P3 P4 P5 P6 P11 P12 P91 P92 P93 P94 P95 kette1 kette2 kette3 kette4 kette5 tsize lspace) ;------------------------------------------------------------------------------------------------------------------ (Setvar "Cmdecho" 0) (setq ALTFANG (getvar "osmode")) (setvar "osmode" 0) (If (= EFNAM nil) (Setq EFNAM "") ) (if (null m_EBE) (setq m_EBE "EBE_1")) ; auf Stahl-Strecke setzen (if (null m_WASTUN) (setq m_WASTUN "WASTUN_1")) ; nur POS-Nr setzen (if (null m_FAKT) (setq m_FAKT "1")) ; Faktor fuer die Grafik (if (null m_STKLI) (setq m_STKLI "1")) ; Stückliste POSITION setzen (if (null m_STKLI_B) (setq m_STKLI_B "1")) ; Stückliste BAUGRUPPE setzen (if (null m_FAHNE) (setq m_FAHNE "1")) ; Positionsfaehnchen setzen (if (null m_UMRAND) (setq m_UMRAND "UMRAND_1")) ; Rechteckige Umrandung (dBox) ;--------------------- ; Layer einstellen ;--------------------- (if (= EBENE 1) (command "_layer" "_m" "L-8" "_c" "7" "" "") ) (if (= EBENE 2) (command "_layer" "_m" "A-8" "_c" "7" "" "") ) (if (= EBENE 3) (command "_layer" "_m" "D-8" "_c" "7" "" "") ) (if (= EBENE 4) (command "_layer" "_m" "P-8" "_c" "7" "" "") ) (if (= EBENE 5) (command "_layer" "_m" "E-8" "_c" "7" "" "") ) (if (= EBENE 6) (command "_layer" "_m" "ILS-POSITION" "_c" "7" "" "") ) (if (= EBENE 7) (command "_layer" "_m" "SPS-1" "_c" "1" "" "") ) ;--------------------------- ;Programme aktivieren ;---------------------------- (if (= m_FAHNE "1") ; Positionsfänchen setzen (posfahne) ) (if (= m_STKLI "1") ; Stückliste für POSITIONEN (progn (Setq X (Getfiled "Auswahl Zeichnugsstücklistendatei" (strcat "h:" "/daten/projekte/") "zei" 4 )) (stcklimp) ) ) (if (= m_STKLI_B "1") ; Stückliste für BAUGRUPPEN (progn (Setq X (Getfiled "Auswahl Zeichnugsstcklistendatei" (strcat "h:" "/daten/projekte/") "cor" 4 )) (stcklimp) ) ) (setvar "osmode" ALTFANG) (Princ) )