247 lines
9.7 KiB
Common Lisp
247 lines
9.7 KiB
Common Lisp
; --------------------------------------------------------------
|
|
; 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 Zeichnugsst�cklistendatei" (strcat "h:" "/daten/projekte/") "cor" 4 ))
|
|
(stcklimp)
|
|
)
|
|
)
|
|
(setvar "osmode" ALTFANG)
|
|
(Princ)
|
|
)
|
|
|