;------------------------------------------------------------------------;
; Baugruppe aus 2 oder 3 Weichen - links oder rechts (STAHL)             ;
;------------------------------------------------------------------------;
; AW 04.05.93/1.12.97                                                    ;
; 27.10.2000  Frankreichweichen integriert                               ;
;------------------------------------------------------------------------;
(defun Dbox (/ Dat)
  (setq Dat (load_dialog (strcat lw "/acadsst/layout/l_bg_wb.DCL")))
  (if (not (new_dialog "l_bg_wb" Dat)) (exit))
  (set_tile "ANZ_" m_ANZ)  
  (set_tile "RI" m_RI)
  (set_tile "WB" m_WB)
  (set_tile "SS" m_SS)
  (set_tile "BEMASSEN" m_BEMASSEN)
  (SetDia)
  (ACTION_TILE "ANZ_"     "(zeig_dia)")
  (ACTION_TILE "RI"       "(zeig_dia)")
  (ACTION_TILE "WB"       "(zeig_dia)")
  (ACTION_TILE "BEMASSEN" "(zeig_dia)")
  (action_tile "accept" "(SetPara) (done_dialog)")
  (action_tile "cancel" "(exit) (done_dialog)")
  (start_dialog)
  (unload_dialog Dat)
)

(defun SetDia()
  (setq breite (dimx_tile "anzeige"))
  (setq hoehe  (dimy_tile "anzeige"))
  (start_image "anzeige")
  (FILL_IMAGE 0 0 breite hoehe -18)
  (if (= m_BEMASSEN "1")  ; mit Bemassung
    (progn
      (if (= m_ANZ "ANZ_1")  ; mit 2 Elementen
        (progn
          (if (= m_RI "RI_L")
            (progn 
              (if (= m_WB "WB_W")
                (slide_image 0 0 breite hoehe "layout(lwb2wdl)")
                (slide_image 0 0 breite hoehe "layout(lwb2bdl)")
              )
            )
          )
          (if (= m_RI "RI_R")
            (progn 
              (if (= m_WB "WB_W")
                (slide_image 0 0 breite hoehe "layout(lwb2wdr)")
                (slide_image 0 0 breite hoehe "layout(lwb2bdr)")
              )
            )
          )
        )
        (progn
          (if (= m_RI "RI_L")
            (progn 
              (if (= m_WB "WB_W")
                (slide_image 0 0 breite hoehe "layout(lwb3wdl)")
                (slide_image 0 0 breite hoehe "layout(lwb3bdl)")
              )
            )
          )
          (if (= m_RI "RI_R")
            (progn 
              (if (= m_WB "WB_W")
                (slide_image 0 0 breite hoehe "layout(lwb3wdr)")
                (slide_image 0 0 breite hoehe "layout(lwb3bdr)")
              )
            )
          )
        )
      )
    )
    (progn
      (if (= m_ANZ "ANZ_1")  ; mit 2 Elementen
        (progn
          (if (= m_RI "RI_L")
            (progn 
              (if (= m_WB "WB_W")
                (slide_image 0 0 breite hoehe "layout(lwb2wl)")
                (slide_image 0 0 breite hoehe "layout(lwb2bl)")
              )
            )
          )
          (if (= m_RI "RI_R")
            (progn 
              (if (= m_WB "WB_W")
                (slide_image 0 0 breite hoehe "layout(lwb2wr)")
                (slide_image 0 0 breite hoehe "layout(lwb2br)")
              )
            )
          )
        )
        (progn
          (if (= m_RI "RI_L")
            (progn 
              (if (= m_WB "WB_W")
                (slide_image 0 0 breite hoehe "layout(lwb3wl)")
                (slide_image 0 0 breite hoehe "layout(lwb3bl)")
              )
            )
          )
          (if (= m_RI "RI_R")
            (progn 
              (if (= m_WB "WB_W")
                (slide_image 0 0 breite hoehe "layout(lwb3wr)")
                (slide_image 0 0 breite hoehe "layout(lwb3br)")
              )
            )
          )
        )
      )
    )
  )
  (end_image)
)

(defun zeig_dia()
  (setq m_ANZ      (get_tile "ANZ_"))
  (setq m_RI       (get_tile "RI"))
  (setq m_WB       (get_tile "WB"))
  (setq m_BEMASSEN (get_tile "BEMASSEN"))
  (SetDia)
)

(defun SetPara ()
  (setq m_ANZ  (get_tile "ANZ_")
    m_RI   (get_tile "RI")
    m_WB   (get_tile "WB")
    m_BEMASSEN (get_tile "BEMASSEN")
    m_SS   (get_tile "SS")
  )
  (if (= m_ANZ "ANZ_1")
    (setq ANZAHL 2)
  )
  (if (= m_ANZ "ANZ_2")
     (setq ANZAHL 3)
  )
  (if (= m_RI "RI_L")
     (setq RICHTUNG "L")
  )
  (if (= m_RI "RI_R")
     (setq RICHTUNG "R")
  )
  (if (= m_WB "WB_W")
     (setq ABSCHLUSS "W")
  )
  (if (= m_WB "WB_B")
     (setq ABSCHLUSS "B")
  )
  (if (= m_SS "SS_G")
     (setq AUSFUEHRUNG "")
  )
  (if (= m_SS "SS_F")
     (setq AUSFUEHRUNG "_F")
  )
)

(defun datain ()  
  (setq auswahl-satz nil)
  (setq MUFFE-ZAEHLER 0)
  (setq ALTFANG (getvar "osmode"))
  ;------------------------
  ;>>>> Eingabeteil <<<<<<<
  ;------------------------
  (initget (+ 1 2 4))
  (setq PT0 (getpoint "\nAnfangspunkt antippen: "))
  (setq PT1 (getpoint PT0 "\n1. Schnittpunkt antippen: "))
  (setq PT2 (getpoint PT1 "\n2. Schnittpunkt antippen: "))
  (bl-name PT0) ;--> Block-Name definieren -> Rckgabe: element-name
  (if (= ANZAHL 3)
     (setq PT3 (getpoint PT2 "\n3. Schnittpunkt antippen: "))
  )

  (setvar "osmode" 0)

  (setq WINK_RAD (angle PT0 PT2))
  (setq WINK_GRA (/ (* WINK_RAD 180) pi))
  ;------------------;
  ;Abst„nde berechnen;
  ;------------------;
  (setq L1 (* (fix (/ (+ (distance PT0 PT1) 1) 2)) 2))
  (setq L2 (* (fix (/ (+ (distance PT1 PT2) 1)2)) 2))
  (if (= ANZAHL 3)
     (setq L3 (* (fix (/ (+ (distance PT2 PT3) 1) 2)) 2))
  )
  (if (or (< L1 650) (< L2 650) (> L1 1800) (> L2 1800))
     (progn
     (alert "Abstand zu gross oder zu klein ...")
     (setvar "osmode" ALTFANG)
     (exit)
     )
  )
  (cond (= ANZAHL 3)
     (if (or (< L3 650) (> L3 1800))
        (progn
        (alert "Abstand zu gross oder zu klein !...")
        (setvar "osmode" ALTFANG)
        (exit)
        )
     )
  )
  (if (= ANZAHL 3)
     (princ (strcat "\nL1= " (rtos L1) " | L2= " (rtos L2) " | L3= " 
            (rtos L3) "\n"))
     (princ (strcat "\nL1= " (rtos L1) " | L2= " (rtos L2) "\n"))
  )
)


(defun geometrie()

  ;--------------------------------------------------------
  ;<<<<<  Konstruktionspunkte definieren >>>>>>>
  ;--------------------------------------------------------
  (if (= RICHTUNG "L")
     (progn 
        (setq PT12 (polar PT1 (+ WINK_RAD (/ pi 2)) 800))
        (setq PT22 (polar PT2 (+ WINK_RAD (/ pi 2)) 800))
        (if (= ANZAHL 3)
           (setq PT32 (polar PT3 (+ WINK_RAD (/ pi 2)) 800))
        )
     )
  )
  (if (= RICHTUNG "R")
     (progn
        (setq PT12 (polar PT1 (- WINK_RAD (/ pi 2)) 800))
        (setq PT22 (polar PT2 (- WINK_RAD (/ pi 2)) 800))
        (if (= ANZAHL 3)
           (setq PT32 (polar PT3 (- WINK_RAD (/ pi 2)) 800))
        )
     )
  )

  ;-----------------
  ; Muffen dazugeben
  ;------------------
  (command "_layer" "_m" "L-6" "_c" "6" "" "")

  (command "_insert" (strcat lw "/acadsst/layout/muffe") PT12 "1" "1" (rtos WINK_GRA))
  (attribute-aendern "0" "0" "" "" "" block-kennung "825002016" "MUFFE ANGESCHWEISST (BG)" "" "")
  (setq auswahl-satz (ssget "_L"))
  (setq MUFFE-ZAEHLER (+ MUFFE-ZAEHLER 1))
  (command "_insert" (strcat lw "/acadsst/layout/muffe") PT22 "" "" (rtos WINK_GRA))
  (attribute-aendern "0" "0" "" "" "" block-kennung "825002016" "MUFFE ANGESCHWEISST (BG)" "" "")
  (ssadd (entlast) auswahl-satz)
  (setq MUFFE-ZAEHLER (+ MUFFE-ZAEHLER 1))
  (if (= ANZAHL 3)
     (progn
        (command "_insert" (strcat lw "/acadsst/layout/muffe") PT32 "" "" (rtos WINK_GRA))
        (attribute-aendern "0" "0" "" "" "" block-kennung "825002016" "MUFFE ANGESCHWEISST (BG)" "" "")
        (ssadd (entlast) auswahl-satz)
        (setq MUFFE-ZAEHLER (+ MUFFE-ZAEHLER 1))
     )
  )

  (if (= ABSCHLUSS "W")    ; ZIEREREI-Muffen setzen
     (progn
       (command "_layer" "_m" "L-7" "_c" "7" "" "")
       (if (= ANZAHL 3)
          (progn
             (command "_insert" (strcat lw "/acadsst/layout/muffe") PT3 "" "" (rtos WINK_GRA))
             (attribute-aendern "0" "0" "" "" "" block-kennung "825004017" "DREIKANTLASCHE" "" "")
             (ssadd (entlast) auswahl-satz)
          )
          (progn
             (command "_insert" (strcat lw "/acadsst/layout/muffe") PT2 "" "" (rtos WINK_GRA))
             (attribute-aendern "0" "0" "" "" "" block-kennung "825004017" "DREIKANTLASCHE" "" "")
             (ssadd (entlast) auswahl-satz)
          )
       )
     )
  )

  (command "_layer" "_m" "L-3" "_c" "3" "" "")
  
  ;-----------------------------------------
  ; Abst„nde analysieren und Elemente setzen 
  ;-----------------------------------------
  ;***********************
  ; 1. Abstand bearbeiten
  ;***********************

  (cond 
     ((< L1 800)
     (if (= RICHTUNG "L")
        (command "_insert" (strcat lw "/acadsst/layout/w90650l7" AUSFUEHRUNG) PT1 "" "" (rtos WINK_GRA))
        (command "_insert" (strcat lw "/acadsst/layout/w90650r7" AUSFUEHRUNG) PT1 "" "" (rtos WINK_GRA))
     )
     (attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
     (ssadd (entlast) auswahl-satz)
     (if (> L1 650)
        (progn
           (setq PT01 (polar PT0 WINK_RAD (- L1 650)))
           (command "_line" PT0 PT01 "")
           (ssadd (entlast) auswahl-satz)
        )
     ))

     ((and (>= L1 800) (<= L1 1800))
     (if (= RICHTUNG "L")
        (command "_insert" (strcat lw "/acadsst/layout/w90650l8" AUSFUEHRUNG) PT1 "" "" (rtos WINK_GRA))
        (command "_insert" (strcat lw "/acadsst/layout/w90650r8" AUSFUEHRUNG) PT1 "" "" (rtos WINK_GRA))
     )
     (attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
     (ssadd (entlast) auswahl-satz)
     (if (> L1 800)
        (progn
        (setq PT01 (polar PT0 WINK_RAD (- L1 800)))
           (command "_insert" (strcat lw "/acadsst/layout/verbind") PT01 "0.5" "0.5" (rtos WINK_GRA))
           (ssadd (entlast) auswahl-satz)
           (command "_insert" (strcat lw "/acadsst/layout/stbg") PT0 (- L1 800) "1" (rtos WINK_GRA))
           (attribute-aendern "0" "0" "" (rtos (- L1 800)) "" block-kennung "" 
                    (strcat " L=" (rtos (- L1 800))) "" "")
           (ssadd (entlast) auswahl-satz)
        )
     ))
  )  ; endcond

  ;***********************
  ; 2. Abstand bearbeiten
  ;***********************
  (command "_insert" (strcat lw "/acadsst/layout/verbind") PT1 "0.5" "0.5" (rtos WINK_GRA))
  (ssadd (entlast) auswahl-satz)
  (cond 
     ((< L2 800)
     (if (= RICHTUNG "L")
        (progn
           (if (= ABSCHLUSS "B")
              (progn
                 (if (= ANZAHL 3)
                    (command "_insert" (strcat lw "/acadsst/layout/w90650l7" AUSFUEHRUNG) PT2 "" "" (rtos WINK_GRA))
                    (command "_insert" (strcat lw "/acadsst/layout/s90650l8") PT2 "" "" (rtos WINK_GRA))
                 )
                 (ssadd (entlast) auswahl-satz)
              )
           )
           (if (= ABSCHLUSS "W")
              (progn
                 (command "_insert" (strcat lw "/acadsst/layout/w90650l7" AUSFUEHRUNG) PT2 "" "" (rtos WINK_GRA))
                 (ssadd (entlast) auswahl-satz)
              )
           )
        )
     )
     (if (= RICHTUNG "R")
        (progn
           (if (= ABSCHLUSS "B")
              (progn
                 (if (= ANZAHL 3)
                    (command "_insert" (strcat lw "/acadsst/layout/w90650r7" AUSFUEHRUNG) PT2 "" "" (rtos WINK_GRA))
                    (command "_insert" (strcat lw "/acadsst/layout/s90650r8") PT2 "" "" (rtos WINK_GRA))
                 )
                 (ssadd (entlast) auswahl-satz)
              )
           )
           (if (= ABSCHLUSS "W")
              (progn
                 (command "_insert" (strcat lw "/acadsst/layout/w90650r7" AUSFUEHRUNG) PT2 "" "" (rtos WINK_GRA))
                 (ssadd (entlast) auswahl-satz)
              )
           )
        )
     )
     (attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
     (if (> L2 650)
        (progn
           (setq PT11 (polar PT1 WINK_RAD (- L2 650)))
           (command "_line" PT1 PT11 "")
           (ssadd (entlast) auswahl-satz)
        )
     ))

     ((and (>= L2 800) (<= L2 1800))
     (if (= RICHTUNG "L")
        (progn
           (if (= ABSCHLUSS "B")
              (progn
                 (if (= ANZAHL 3)
                    (command "_insert" (strcat lw "/acadsst/layout/w90650l8" AUSFUEHRUNG) PT2 "" "" (rtos WINK_GRA))
                    (command "_insert" (strcat lw "/acadsst/layout/s90650l8") PT2 "" "" (rtos WINK_GRA))
                 )
              )
           )
           (if (= ABSCHLUSS "W")
              (progn
                 (command "_insert" (strcat lw "/acadsst/layout/w90650l8" AUSFUEHRUNG) PT2 "" "" (rtos WINK_GRA))
              )
           )
        )
     )
     (if (= RICHTUNG "R")
        (progn
           (if (= ABSCHLUSS "B")
              (progn
                 (if (= ANZAHL 3)
                    (command "_insert" (strcat lw "/acadsst/layout/w90650r8" AUSFUEHRUNG) PT2 "" "" (rtos WINK_GRA))
                    (command "_insert" (strcat lw "/acadsst/layout/s90650r8") PT2 "" "" (rtos WINK_GRA))
                 )
              )
           )
           (if (= ABSCHLUSS "W")
              (progn
                 (command "_insert" (strcat lw "/acadsst/layout/w90650r8" AUSFUEHRUNG) PT2 "" "" (rtos WINK_GRA))
              )
           )
        )
     )
     (attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
     (ssadd (entlast) auswahl-satz)
     (if (> L2 800)
        (progn
           (setq PT11 (polar PT1 WINK_RAD (- L2 800)))
           (command "_insert" (strcat lw "/acadsst/layout/verbind") PT11 "0.5" "0.5" (rtos WINK_GRA))
           (ssadd (entlast) auswahl-satz)
           (command "_insert" (strcat lw "/acadsst/layout/stbg") PT1 (- L2 800) "1" (rtos WINK_GRA))
           (attribute-aendern "0" "0" "" (rtos (- L2 800)) "" block-kennung "" 
                        (strcat " L=" (rtos (- L2 800))) "" "")
           (ssadd (entlast) auswahl-satz)
        )
     ))
  )  ; endcond
  ;***********************
  ; 3. Abstand bearbeiten
  ;***********************
  (if (= ANZAHL 3)
    (progn
       (command "_insert" (strcat lw "/acadsst/layout/verbind") PT2 "0.5" "0.5" (rtos WINK_GRA))
       (ssadd (entlast) auswahl-satz)
       (cond 
          ((< L3 800)
          (if (= RICHTUNG "L")
             (progn
                (if (= ABSCHLUSS "W")
                   (command "_insert" (strcat lw "/acadsst/layout/w90650l7" AUSFUEHRUNG) PT3 "" "" (rtos WINK_GRA))
                   (command "_insert" (strcat lw "/acadsst/layout/s90650l8") PT3 "" "" (rtos WINK_GRA))
                )
             )
          )
          (if (= RICHTUNG "R")
             (progn
                (if (= ABSCHLUSS "W")
                   (command "_insert" (strcat lw "/acadsst/layout/w90650r7" AUSFUEHRUNG) PT3 "" "" (rtos WINK_GRA))
                   (command "_insert" (strcat lw "/acadsst/layout/s90650r8") PT3 "" "" (rtos WINK_GRA))
                )
             )
          )
          (attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
          (ssadd (entlast) auswahl-satz)
          (if (> L3 650)
             (progn
                (setq PT21 (polar PT2 WINK_RAD (- L3 650)))
                (command "_line" PT2 PT21 "")
                (ssadd (entlast) auswahl-satz)
             )
          ))

       ((and (>= L3 800) (<= L3 1800))
     (if (= RICHTUNG "L")
        (progn
           (if (= ABSCHLUSS "W")
              (command "_insert" (strcat lw "/acadsst/layout/w90650l8" AUSFUEHRUNG) PT3 "" "" (rtos WINK_GRA))
              (command "_insert" (strcat lw "/acadsst/layout/s90650l8") PT3 "" "" (rtos WINK_GRA))
           )
        )
     )
     (if (= RICHTUNG "R")
        (progn
           (if (= ABSCHLUSS "W")
              (command "_insert" (strcat lw "/acadsst/layout/w90650r8" AUSFUEHRUNG) PT3 "" "" (rtos WINK_GRA))
              (command "_insert" (strcat lw "/acadsst/layout/s90650r8") PT3 "" "" (rtos WINK_GRA))
           )
        )
     )   
       (attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
       (ssadd (entlast) auswahl-satz)
       (if (> L3 800)
          (progn
          (setq PT21 (polar PT2 WINK_RAD (- L3 800)))
             (command "_insert" (strcat lw "/acadsst/layout/verbind") PT21 "0.5" "0.5" (rtos WINK_GRA))
             (ssadd (entlast) auswahl-satz)
             (command "_insert" (strcat lw "/acadsst/layout/stbg") PT2 (- L3 800) "1" (rtos WINK_GRA))
             (attribute-aendern "0" "0" "" (rtos (- L3 800)) "" block-kennung "" 
                           (strcat " L=" (rtos (- L3 800))) "" "")
             (ssadd (entlast) auswahl-satz)
          )
       ))
    )  ; endcond

    )  ;---endprogn

  )  ;--- endif
)

(defun BEMASSUNG ()
  ;---------
  ; Bemaáung
  ;---------
  (command "_layer" "_m" "L-10" "_c" "10" "" "")
  (command "_dim")
  (command "_dimtad" "0")
  (command "_dimtxt" "125")
  (command "_dimasz" "40")
  (if (= RICHTUNG "L")
     (setq WINK_BEM (- WINK_RAD (/ pi 2)))
     (setq WINK_BEM (+ WINK_RAD (/ pi 2)))
  )
  (command "_align" PT0  PT1 (polar PT0 WINK_BEM 200) "")
  (command "_con" PT2 "")
  (if (= ANZAHL 3)
     (progn
     (command "_con" PT3 "")
     (command "_align" PT0 PT3 (polar PT0 WINK_BEM 400) "")
     )
     (command "_align" PT0 PT2 (polar PT0 WINK_BEM 400) "" )
  )
  (command "_exit")
  (command "_layer" "_m" "L-3" "_c" "3" "" "")
)

;------------------------------------------------------------------------------
(defun c:l_bg_wb ( / anzahl richtung abschluss wink_rad wink_gra pt0 
                     pt1 pt2 pt3 l1 l2 l3 pt12 pt13 pt22 pt32)
  (setvar "limcheck" 0)
  (prompt "**** Group from 2 or 3 switches - left or right *******")
  (prompt "")
  (if (null m_ANZ)      (setq m_ANZ "ANZ_1"))  ; Anzahl Elemente
  (if (null m_RI)       (setq m_RI "RI_L"))    ; Links
  (if (null m_WB)       (setq m_WB "WB_W"))    ; Weiche
  (if (null m_BEMASSEN) (setq m_BEMASSEN "1")) ; mit Bemassung 
  (if (null m_SS) 			(setq m_SS "SS_G"))    ; Ausführung der Weiche - Standard oder SSF
  (dbox)
  (datain)
  (geometrie)
  (mach-block PT0 "0" auswahl-satz)
  (setq auswahl-satz nil)
  (if (= ABSCHLUSS "W")
     (progn
        (if (= ANZAHL 3)
           (setq BEZ (strcat "** BG " (itoa ANZAHL) "W R650/90-" RICHTUNG "-" (itoa L1) 
                      "-" (itoa L2) "-" (itoa L3)))
           (setq BEZ (strcat "** BG "(itoa ANZAHL) "W R650/90-" RICHTUNG "-" (itoa L1) 
                     "-" (itoa L2)))
        )
     )
  ) 
  (if (= ABSCHLUSS "B")
     (progn
        (if (= ANZAHL 3)
           (setq BEZ (strcat "** BG 2W+STBL R650/90-" RICHTUNG "-" (itoa L1) 
                      "-" (itoa L2) "-" (itoa L3)))
           (setq BEZ (strcat "** BG 1W+STBL R650/90-" RICHTUNG "-" (itoa L1) 
                     "-" (itoa L2)))
        )
     )
  )
  (setq BEZ (strcat BEZ " + " (rtos MUFFE-ZAEHLER) " MUFFE(N)"))
  (attribute-aendern "0" "2" "1" "" "" block-kennung "111111111" (strcat BEZ " [BG1]") "" "")  ; in SSTBASE.LSP
  (if (= m_BEMASSEN "1")
    (bemassung)
  )
  (setvar "osmode" ALTFANG)
)
;------------------------------------------------------------------------------