; --------------------------------------------------------------
; 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)
)
