417 lines
16 KiB
Common Lisp
417 lines
16 KiB
Common Lisp
;------------------------------------------------------------------------;
|
|
; Wechsel - links oder rechts ;
|
|
;------------------------------------------------------------------------;
|
|
; AW 10.05.93/2.1.98/ ;
|
|
; 27.10.2000 Frankreichweichen integriert ;
|
|
;------------------------------------------------------------------------;
|
|
(defun Dbox (/ Dat)
|
|
(setq Dat (load_dialog (strcat lw "/acadsst/layout/l_bg_wec.DCL")))
|
|
(if (not (new_dialog "l_bg_wec" Dat)) (exit))
|
|
(set_tile "RI" m_RI)
|
|
(set_tile "WB1" m_WB1)
|
|
(set_tile "WB2" m_WB2)
|
|
(set_tile "SS" m_SS)
|
|
(set_tile "BEMASSEN" m_BEMASSEN)
|
|
(SetDia)
|
|
(ACTION_TILE "RI" "(zeig_dia)")
|
|
(ACTION_TILE "WB1" "(zeig_dia)")
|
|
(ACTION_TILE "WB2" "(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_RI "RI_L") ; LINKS
|
|
(progn
|
|
(if (= m_WB1 "WB1_W") ; Weiche als 1.Element
|
|
(progn
|
|
(if (= m_WB2 "WB2_W") ; Weiche als 2.Element
|
|
(slide_image 0 0 breite hoehe "layout(wewwdl)")
|
|
(slide_image 0 0 breite hoehe "layout(wewbdl)")
|
|
)
|
|
)
|
|
)
|
|
(if (= m_WB1 "WB1_B") ; Bogen als 1.Element
|
|
(progn
|
|
(if (= m_WB2 "WB2_W") ; Weiche als 2.Elemet
|
|
(slide_image 0 0 breite hoehe "layout(webwdl)")
|
|
(slide_image 0 0 breite hoehe "layout(webbdl)")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(if (= m_RI "RI_R") ; RECHTS
|
|
(progn
|
|
(if (= m_WB1 "WB1_W") ; Weiche als 1.Element
|
|
(progn
|
|
(if (= m_WB2 "WB2_W") ; Weiche als 2.Element
|
|
(slide_image 0 0 breite hoehe "layout(wewwdr)")
|
|
(slide_image 0 0 breite hoehe "layout(wewbdr)")
|
|
)
|
|
)
|
|
)
|
|
(if (= m_WB1 "WB1_B") ; Bogen als 1.Element
|
|
(progn
|
|
(if (= m_WB2 "WB2_W") ; Weiche als 2.Elemet
|
|
(slide_image 0 0 breite hoehe "layout(webwdr)")
|
|
(slide_image 0 0 breite hoehe "layout(webbdr)")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(if (= m_BEMASSEN "0") ; OHNE Bemassung
|
|
(progn
|
|
(if (= m_RI "RI_L") ; LINKS
|
|
(progn
|
|
(if (= m_WB1 "WB1_W") ; Weiche als 1.Element
|
|
(progn
|
|
(if (= m_WB2 "WB2_W") ; Weiche als 2.Element
|
|
(slide_image 0 0 breite hoehe "layout(wewwl)")
|
|
(slide_image 0 0 breite hoehe "layout(wewbl)")
|
|
)
|
|
)
|
|
)
|
|
(if (= m_WB1 "WB1_B") ; Bogen als 1.Element
|
|
(progn
|
|
(if (= m_WB2 "WB2_W") ; Weiche als 2.Elemet
|
|
(slide_image 0 0 breite hoehe "layout(webwl)")
|
|
(slide_image 0 0 breite hoehe "layout(webbl)")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(if (= m_RI "RI_R") ; RECHTS
|
|
(progn
|
|
(if (= m_WB1 "WB1_W") ; Weiche als 1.Element
|
|
(progn
|
|
(if (= m_WB2 "WB2_W") ; Weiche als 2.Element
|
|
(slide_image 0 0 breite hoehe "layout(wewwr)")
|
|
(slide_image 0 0 breite hoehe "layout(wewbr)")
|
|
)
|
|
)
|
|
)
|
|
(if (= m_WB1 "WB1_B") ; Bogen als 1.Element
|
|
(progn
|
|
(if (= m_WB2 "WB2_W") ; Weiche als 2.Elemet
|
|
(slide_image 0 0 breite hoehe "layout(webwr)")
|
|
(slide_image 0 0 breite hoehe "layout(webbr)")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(end_image)
|
|
)
|
|
|
|
(defun zeig_dia()
|
|
(setq m_RI (get_tile "RI"))
|
|
(setq m_WB1 (get_tile "WB1"))
|
|
(setq m_WB2 (get_tile "WB2"))
|
|
(setq m_BEMASSEN (get_tile "BEMASSEN"))
|
|
(SetDia)
|
|
)
|
|
|
|
(defun SetPara ()
|
|
(setq m_RI (get_tile "RI")
|
|
m_WB1 (get_tile "WB1")
|
|
m_WB2 (get_tile "WB2")
|
|
m_SS (get_tile "SS")
|
|
m_BEMASSEN (get_tile "BEMASSEN")
|
|
)
|
|
(if (= m_RI "RI_L")
|
|
(setq RICHTUNG "L")
|
|
)
|
|
(if (= m_RI "RI_R")
|
|
(setq RICHTUNG "R")
|
|
)
|
|
(if (= m_WB1 "WB1_W")
|
|
(setq ANFANG "W1")
|
|
)
|
|
(if (= m_WB1 "WB1_B")
|
|
(setq ANFANG "B1")
|
|
)
|
|
(if (= m_WB2 "WB2_W")
|
|
(setq ABSCHLUSS "W2")
|
|
)
|
|
(if (= m_WB2 "WB2_B")
|
|
(setq ABSCHLUSS "B2")
|
|
)
|
|
(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 "\nPick 1.Intersection: "))
|
|
(setq PT01 (getpoint PT0 "\nPick 2.Intersection: "))
|
|
(bl-name PT0) ;--> Block-Name definieren -> R�ckgabe: element-name
|
|
(setvar "osmode" 0)
|
|
|
|
(if (= RICHTUNG "L")
|
|
(setq WINK_RAD (- (angle PT0 PT01) (/ pi 2)))
|
|
(setq WINK_RAD (+ (angle PT0 PT01) (/ pi 2)))
|
|
)
|
|
(setq WINK_GRA (/ (* WINK_RAD 180) pi))
|
|
|
|
;------------------;
|
|
;Abst„nde berechnen;
|
|
;------------------;
|
|
(setq L1 (* (fix (/ (+ (distance PT0 PT01) 1) 2)) 2))
|
|
(if (or (< L1 700) (> L1 1800))
|
|
(progn
|
|
(alert "Distance too big or small ...")
|
|
(setvar "osmode" ALTFANG)
|
|
(exit)
|
|
)
|
|
)
|
|
(princ (strcat "\nL= " (rtos L1) "\n"))
|
|
)
|
|
|
|
(defun geometrie()
|
|
;--------------------------------------------------------
|
|
;<<<<< Konstruktionspunkte definieren >>>>>>>
|
|
;--------------------------------------------------------
|
|
(if (= RICHTUNG "L")
|
|
(setq PT1 (polar PT0 (+ WINK_RAD (/ pi 4)) (* (sqrt 2) L1)))
|
|
(setq PT1 (polar PT0 (- WINK_RAD (/ pi 4)) (* (sqrt 2) L1)))
|
|
)
|
|
(setq PT3 (polar PT0 (- WINK_RAD pi) 425)
|
|
PT4 (polar PT1 WINK_RAD 425)
|
|
PT5 (polar PT0 WINK_RAD 375)
|
|
PT8 (polar PT1 (- WINK_RAD pi) 375)
|
|
PT9 (polar PT1 (- WINK_RAD pi) (+ L1 425))
|
|
PT10 (polar PT0 WINK_RAD (+ L1 425))
|
|
)
|
|
|
|
;-----------------
|
|
; Muffen dazugeben
|
|
;------------------
|
|
(command "_layer" "_m" "L-6" "_c" "6" "" "")
|
|
(command "_insert" (strcat lw "/acadsst/layout/muffe") PT3 "" "" (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") PT4 "" "" (rtos WINK_GRA))
|
|
(attribute-aendern "0" "0" "" "" "" block-kennung "825002016" "MUFFE ANGESCHWEISST (BG)" "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
(setq MUFFE-ZAEHLER (+ MUFFE-ZAEHLER 1))
|
|
(if (= ANFANG "W1")
|
|
(progn
|
|
(command "_layer" "_m" "L-3" "_c" "3" "" "")
|
|
(command "_insert" (strcat lw "/acadsst/layout/verbind") PT5 "0.5" "0.5" (rtos WINK_GRA))
|
|
(ssadd (entlast) auswahl-satz)
|
|
(command "_insert" (strcat lw "/acadsst/layout/stbg") PT5 (+ L1 50) "1" (rtos WINK_GRA))
|
|
(attribute-aendern "0" "0" "" (rtos (+ L1 50)) "" block-kennung "" (strcat " L=" (rtos (+ L1 50))) "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
(command "_layer" "_m" "L-6" "_c" "6" "" "")
|
|
(command "_insert" (strcat lw "/acadsst/layout/muffe") PT10 "" "" (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 "W2")
|
|
(progn
|
|
(command "_layer" "_m" "L-3" "_c" "3" "" "")
|
|
(command "_insert" (strcat lw "/acadsst/layout/verbind") PT8 "0.5" "0.5" (rtos WINK_GRA))
|
|
(ssadd (entlast) auswahl-satz)
|
|
(command "_insert" (strcat lw "/acadsst/layout/stbg") PT8 (+ L1 50) "1" (rtos (+ WINK_GRA 180)))
|
|
(attribute-aendern "0" "0" "" (rtos (+ L1 50)) "" block-kennung "" (strcat " L=" (rtos (+ L1 50))) "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
(command "_layer" "_m" "L-6" "_c" "6" "" "")
|
|
(command "_insert" (strcat lw "/acadsst/layout/muffe") PT9 "" "" (rtos WINK_GRA))
|
|
(attribute-aendern "0" "0" "" "" "" block-kennung "825002016" "MUFFE ANGESCHWEISST (BG)" "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
(setq MUFFE-ZAEHLER (+ MUFFE-ZAEHLER 1))
|
|
)
|
|
)
|
|
|
|
(command "_layer" "_m" "L-3" "_c" "3" "" "")
|
|
|
|
;-----------------------------------------
|
|
; Abstand analysieren und Elemente setzen
|
|
;-----------------------------------------
|
|
(cond
|
|
((< L1 800)
|
|
(if (and (= ANFANG "W1") (= RICHTUNG "L"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/w45650l3" AUSFUEHRUNG) PT0 "" "" (rtos WINK_GRA))
|
|
)
|
|
(if (and (= ANFANG "B1") (= RICHTUNG "L"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/s45650l4") PT0 "" "" (rtos WINK_GRA))
|
|
)
|
|
(if (and (= ANFANG "W1") (= RICHTUNG "R"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/w45650r3" AUSFUEHRUNG) PT0 "" "" (rtos WINK_GRA))
|
|
)
|
|
(if (and (= ANFANG "B1") (= RICHTUNG "R"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/s45650r4") PT0 "" "" (rtos WINK_GRA))
|
|
)
|
|
(attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
(if (= RICHTUNG "L")
|
|
(setq PT6 (polar PT0 (+ WINK_RAD (/ pi 4)) (* (sqrt 2) 350))
|
|
PT7 (polar PT1 (+ WINK_RAD (* 5 (/ pi 4))) (* (sqrt 2) 350))
|
|
)
|
|
)
|
|
(if (= RICHTUNG "R")
|
|
(setq PT6 (polar PT0 (- WINK_RAD (/ pi 4)) (* (sqrt 2) 350))
|
|
PT7 (polar PT1 (- WINK_RAD pi ) (* (sqrt 2) 350))
|
|
)
|
|
)
|
|
(command "_insert" (strcat lw "/acadsst/layout/verbind") PT6 "0.5" "0.5" (rtos WINK_GRA))
|
|
(ssadd (entlast) auswahl-satz)
|
|
(if (> L1 700)
|
|
(progn
|
|
(command "_line" PT6 PT7 "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
)
|
|
)
|
|
(if (and (= ABSCHLUSS "W2") (= RICHTUNG "L"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/w45650l3" AUSFUEHRUNG) PT1 "" "" (rtos (+ WINK_GRA 180)))
|
|
)
|
|
(if (and (= ABSCHLUSS "B2") (= RICHTUNG "L"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/s45650l4") PT1 "" "" (rtos (+ WINK_GRA 180)))
|
|
)
|
|
(if (and (= ABSCHLUSS "W2") (= RICHTUNG "R"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/w45650r3" AUSFUEHRUNG) PT1 "" "" (rtos (+ WINK_GRA 180)))
|
|
)
|
|
(if (and (= ABSCHLUSS "B2") (= RICHTUNG "R"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/s45650r4") PT1 "" "" (rtos (+ WINK_GRA 180)))
|
|
)
|
|
(attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
)
|
|
|
|
((and (>= L1 800) (<= L1 1800))
|
|
(if (and (= ANFANG "W1") (= RICHTUNG "L"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/w45650l4" AUSFUEHRUNG) PT0 "" "" (rtos WINK_GRA))
|
|
)
|
|
(if (and (= ANFANG "B1") (= RICHTUNG "L"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/s45650l4") PT0 "" "" (rtos WINK_GRA))
|
|
)
|
|
(if (and (= ANFANG "W1") (= RICHTUNG "R"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/w45650r4" AUSFUEHRUNG) PT0 "" "" (rtos WINK_GRA))
|
|
)
|
|
(if (and (= ANFANG "B1") (= RICHTUNG "R"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/s45650r4") PT0 "" "" (rtos WINK_GRA))
|
|
)
|
|
(attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
(if (= RICHTUNG "L")
|
|
(setq PT6 (polar PT0 (+ WINK_RAD (/ pi 4)) (* (sqrt 2) 400))
|
|
PT7 (polar PT1 (+ WINK_RAD (* 5 (/ pi 4))) (* (sqrt 2) 400))
|
|
)
|
|
)
|
|
(if (= RICHTUNG "R")
|
|
(setq PT6 (polar PT0 (- WINK_RAD (/ pi 4)) (* (sqrt 2) 400))
|
|
PT7 (polar PT1 (- WINK_RAD (* 5 (/ pi 4))) (* (sqrt 2) 400))
|
|
)
|
|
)
|
|
(command "_insert" (strcat lw "/acadsst/layout/verbind") PT6 "0.5" "0.5" (rtos WINK_GRA))
|
|
(ssadd (entlast) auswahl-satz)
|
|
(if (> L1 800)
|
|
(progn
|
|
(command "_insert" (strcat lw "/acadsst/layout/verbind") PT7 "0.5" "0.5" (rtos WINK_GRA))
|
|
(ssadd (entlast) auswahl-satz)
|
|
(if (= RICHTUNG "L")
|
|
(command "_insert" (strcat lw "/acadsst/layout/stbg") PT6 (- (fix (sqrt (* (expt L1 2) 2))) 1130) "1" (rtos (+ WINK_GRA 45)))
|
|
(command "_insert" (strcat lw "/acadsst/layout/stbg") PT6 (- (fix (sqrt (* (expt L1 2) 2))) 1130) "1" (rtos (+ WINK_GRA 315)))
|
|
)
|
|
(attribute-aendern "0" "0" "" (itoa (- (fix (sqrt (* (expt L1 2) 2))) 1130)) "" block-kennung "" (strcat " L=" (itoa (- (fix (sqrt (* (expt L1 2) 2))) 1130))) "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
)
|
|
)
|
|
(if (and (= ABSCHLUSS "W2") (= RICHTUNG "L"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/w45650l4" AUSFUEHRUNG) PT1 "" "" (rtos (+ WINK_GRA 180)))
|
|
)
|
|
(if (and (= ABSCHLUSS "B2") (= RICHTUNG "L"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/s45650l4") PT1 "" "" (rtos (+ WINK_GRA 180)))
|
|
)
|
|
(if (and (= ABSCHLUSS "W2") (= RICHTUNG "R"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/w45650r4" AUSFUEHRUNG) PT1 "" "" (rtos (+ WINK_GRA 180)))
|
|
)
|
|
(if (and (= ABSCHLUSS "B2") (= RICHTUNG "R"))
|
|
(command "_insert" (strcat lw "/acadsst/layout/s45650r4") PT1 "" "" (rtos (+ WINK_GRA 180)))
|
|
)
|
|
(attribute-aendern "0" "0" "" "" "" block-kennung "" " (BG)" "" "")
|
|
(ssadd (entlast) auswahl-satz)
|
|
)
|
|
) ; endcond
|
|
)
|
|
|
|
(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)))
|
|
)
|
|
(setvar "osmode" 0)
|
|
(command "_align" (polar PT0 (+ WINK_RAD pi) 425) (polar PT0 WINK_RAD (+ L1 425)) (polar PT0 WINK_BEM 200) "")
|
|
(command "_exit")
|
|
(command "_layer" "_m" "L-3" "_c" "3" "" "")
|
|
)
|
|
|
|
;------------------------------------------------------------------------------
|
|
(defun c:l_bg_wec ()
|
|
(setvar "limcheck" 0)
|
|
(prompt "**** Crossing - left or right *******")
|
|
(prompt "")
|
|
(if (null m_RI) (setq m_RI "RI_L")) ; Links
|
|
(if (null m_WB1) (setq m_WB1 "WB1_W")) ; Weiche o. Bogen
|
|
(if (null m_WB2) (setq m_WB2 "WB2_B")) ; Weiche o. Bogen
|
|
(if (null m_SS) (setq m_SS "SS_G")) ; Ausführung der Weiche - Standard oder SSF
|
|
(if (null m_BEMASSEN) (setq m_BEMASSEN "1")) ; mit Bemaáung
|
|
(dbox)
|
|
(datain)
|
|
(geometrie)
|
|
(mach-block PT0 "0" auswahl-satz)
|
|
(setq auswahl-satz nil)
|
|
(if (= ANFANG "W1")
|
|
(setq BEZ1 "** BG WECHSEL W/")
|
|
(setq BEZ1 "** BG WECHSEL STBL/")
|
|
)
|
|
(if (= ABSCHLUSS "W2")
|
|
(setq BEZ2 (strcat "W R650/45-" RICHTUNG "-" (itoa L1)))
|
|
(setq BEZ2 (strcat "STBL R650/45-" RICHTUNG "-" (itoa L1)))
|
|
)
|
|
(setq BEZ (strcat BEZ1 BEZ2))
|
|
(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)
|
|
)
|
|
;------------------------------------------------------------------------------ |