m.stangl/Walz
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
Walz/MODULE/B_TYP4.LSP
T

300 lines
13 KiB
Common Lisp
Raw Permalink Blame History

;------------------------------------------------------------------------;
; Bügelplätze zeichnen - TYP 4 - ;
; -----------------------------------------------------------------------;
; 27.09.93 / 13.6.98 ;
;------------------------------------------------------------------------;
(defun Dbox (/ Dat)
(setq Dat (load_dialog (strcat lw "/acadsst/module/b_typ4.dcl")))
(if (not (new_dialog "b_typ4" Dat)) (exit))
(set_tile "L1" m_L1)
(set_tile "L2" m_L2)
(set_tile "L3" m_L3)
(set_tile "K0" m_K0)
(set_tile "ART" m_ART)
(SetDia)
(ACTION_TILE "ART" "(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_ART "ART_1") ; Nr 1
(slide_image 0 0 breite hoehe "arbplz(btyp04_1)")
)
(if (= m_ART "ART_2") ; Nr 2
(slide_image 0 0 breite hoehe "arbplz(btyp04_2)")
)
(if (= m_ART "ART_3") ; Nr 3
(slide_image 0 0 breite hoehe "arbplz(btyp04_3)")
)
(end_image)
)
(defun zeig_dia()
(setq m_ART (get_tile "ART"))
(SetDia)
)
(defun SetPara ()
(setq m_L1 (get_tile "L1") ; Streckenabstand
m_K0 (get_tile "K0") ; Anzahl Plätze
m_ART (get_tile "ART") ; Art
m_L2 (get_tile "L2") ; Tiefe
m_L3 (get_tile "L3") ; lichte Weite
)
)
(defun datain()
(setq L1 (atoi m_L1)) ; Streckenabstand
(setq K0 (atoi m_K0)) ; Anzahl Plätze
(setq ART (atoi (substr m_ART 5 1))) ; Art
(setq L2 (atoi m_L2)) ; Tiefe
(setq L3 (atoi m_L3)) ; lichte Weite
;----------------------------------------------------------------------;
; >>>>>> Eingabeteil <<<<<< ;
;----------------------------------------------------------------------;
(setq P0 (getpoint "\nUntere linke Ecke definieren: "))
(initget (+ 2 4))
;----------------------------------------------------------------------;
; >>>>>> Pr�fung ob die Grenzwerte eingehalten sind <<<<<< ;
;----------------------------------------------------------------------;
(while (or (< L1 800) (> L1 2000))
(initget (+ 1 2 4))
(setq L1 (getreal "\nStreckenabstand eingeben [800-2000]: "))
)
(while (or (< L2 1500) (> L2 6000))
(initget (+ 1 2 4))
(setq L2 (getint "\nTiefe eingeben [1500-6000]: "))
)
(while (or (< L3 1000) (> L3 3000))
(initget (+ 1 2 4))
(setq L3 (getint "\nlichte Weite zw. den Pl„tzen eingeben [1000-3000]: "))
)
;----------------------------------------------------------------------;
; >>>>>> Prüfung welche Radien verwendet werden <<<<<< ;
;----------------------------------------------------------------------;
(if
(and (>= L3 1000) (< L3 1400))
(setq R 400)
)
(if
(and (>= L3 1400) (<= L3 3000))
(setq R 650)
)
)
(defun punkte()
;-----------------------------------------------------------------------;
; >>>>>> Konstruktionspunkte definieren <<<<<< ;
;-----------------------------------------------------------------------;
(setq P1 (list (car p0) (+ (cadr p0) L2)))
(setq P2 (list (+ (car p1) L1) (cadr p1)))
(setq P3 (list (+ (car p0) L1) (cadr p0)))
(cond
((= R 400)
(setq P4 (list (car p0) (+ (cadr p0) 500)))
(setq P5 (list (car p3) (+ (cadr p3) 500)))
(setq P6 (list (car p1) (- (cadr p1) 500)))
(setq P7 (list (car P2) (- (cadr p2) 500)))
(setq P8 (list (+ (car p1) 500) (cadr p1)))
(setq P9 (list (- (car p2) 500) (cadr p2)))
(setq P10 (list (+ (car p3) 500) (cadr p3)))
(setq P11 (list (+ (car p3) (- L3 500))(cadr p3)))
(setq P12 (list (- (car p0) 1100) (- (cadr p0) 300)))
(setq P13 (list (+ (car p11) 300) (+ (cadr p2) 2500)))
)
((= R 650)
(setq P4 (list (car p0) (+ (cadr p0) 800)))
(setq P5 (list (car p3) (+ (cadr p3) 800)))
(setq P6 (list (car p1) (- (cadr p1) 500)))
(setq P7 (list (car P2) (- (cadr p2) 500)))
(setq P8 (list (+ (car p1) 500) (cadr p1)))
(setq P9 (list (- (car p2) 500) (cadr p2)))
(setq P10 (list (+ (car p3) 800) (cadr p3)))
(setq P11 (list (+ (car p3) (- L3 800))(cadr p3)))
(setq P12 (list (- (car p0) 1100) (- (cadr p0) 300)))
(setq P13 (list (+ (car p11) 300) (+ (cadr p2) 2500)))
)
)
(cond
((= ART 1)
(setq P14 (list (- (car p0) 700) (cadr p0)))
(setq P15 (list (- (car p3) (+ (/ l1 2) 187.5)) (cadr p3)))
(setq P16 (list (car p0) (+ (cadr p0) (- (/ L2 2) 187.5))))
(setq P17 (list (car p3) (+ (cadr p3) (+ (/ l2 2) 187.5))))
(setq P18 (list (+ (car p1) (/ l1 2)) (cadr p1)))
(setq P19 (list (car p2) (+ (cadr p2) 2000)))
(setq P20 (list (- (car p19) 560) (- (cadr p19) 700)))
(setq p21 (list (+ (car p1) 530) (+ (cadr p1) 700)))
(setq p22 (list (car p2) (- (cadr p2) 100)))
)
((= ART 2)
(setq P14 (list (- (car p0) 350) (cadr p0)))
(setq P15 (list (- (car p3) (- (/ l1 2) 187.5)) (cadr p3)))
(setq P16 (list (car p0) (+ (cadr p0) (+ (/ L2 2) 187.5))))
(setq P17 (list (car p3) (+ (cadr p3) (- (/ l2 2) 187.5))))
(setq P18 (list (+ (car p1) (/ l1 2)) (cadr p1)))
(setq P19 (list (car p2) (+ (cadr p2) 2000)))
(setq P20 (list (- (car p19) 560) (- (cadr p19) 700)))
(setq p21 (list (+ (car p1) 200) (+ (cadr p1) 150)))
(setq p22 (list (- (car p2) 200) (+ (cadr p2) 820)))
)
((= ART 3)
(setq P14 (list (- (car p0) 700) (cadr p0)))
(setq P15 (list (- (car p3) (+ (/ l1 2) 187.5)) (cadr p3)))
(setq P16 (list (car p0) (+ (cadr p0) (- (/ L2 2) 187.5))))
(setq P17 (list (car p3) (+ (cadr p3) (+ (/ l2 2) 187.5))))
(setq P18 (list (+ (car p1) (/ l1 2)) (cadr p1)))
(setq P19 (list (- (car p1) 350) (+ (cadr p1) 400)))
(setq P20 (list (+ (car p19) 1000) (+ (cadr p19) 700)))
(setq p21 (list (+ (car p1) 530) (+ (cadr p1) 700)))
(setq p22 (list (car p2) (- (cadr p2) 100)))
)
)
)
(defun geometrie()
;-----------------------------------------------------------------------;
; >>>>>> Blöcke einfügen <<<<<< ;
;-----------------------------------------------------------------------;
(command "_layer" "_m" "L-2" "_c" "2" "" "")
(cond
((= R 400)
(command "_insert" (strcat lw "/acadsst/layout/w90400l5") P0 "" "" "")
(setq auswahl-satz (ssget "_L"))
(command "_insert" (strcat lw "/acadsst/layout/w90400r5") P3 "" "" "180")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/layout/s90400l5") P1 "" "" "180")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/layout/s90400l5") P2 "" "" "90")
(ssadd (entlast) auswahl-satz)
(command "_line" p4 p6 "")
(ssadd (entlast) auswahl-satz)
(command "_line" p5 p7 "")
(ssadd (entlast) auswahl-satz)
(command "_line" p8 p9 "")
(ssadd (entlast) auswahl-satz)
(command "_line" p10 p11 "")
(ssadd (entlast) auswahl-satz)
(command "_line" p0 p3 "")
(ssadd (entlast) auswahl-satz)
)
((= R 650)
(command "_insert" (strcat lw "/acadsst/layout/w90650l8") P0 "" "" "")
(setq auswahl-satz (ssget "_L"))
(command "_insert" (strcat lw "/acadsst/layout/w90650r8") P3 "" "" "180")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/layout/s90400l5") P1 "" "" "180")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/layout/s90400l5") P2 "" "" "90")
(ssadd (entlast) auswahl-satz)
(command "_line" p4 p6 "")
(ssadd (entlast) auswahl-satz)
(command "_line" p5 p7 "")
(ssadd (entlast) auswahl-satz)
(command "_line" p8 p9 "")
(ssadd (entlast) auswahl-satz)
(command "_line" p10 p11 "")
(ssadd (entlast) auswahl-satz)
(command "_line" p0 p3 "")
(ssadd (entlast) auswahl-satz)
)
)
;-----------------------------------------------------------------------;
; >>>>>> Pfeile + Maschinen setzen <<<<<< ;
;-----------------------------------------------------------------------;
(command "_layer" "_m" "Z-1" "_c" "1" "" "")
(cond
((= ART 1)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_v") p14 "" "" "")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") p15 "" "" "")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_v") p16 "" "" "90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") p17 "" "" "-90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/maus") p20 "" "" "-90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/vario14") p19 "" "" "180")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/buegelr") p18 "" "" "-90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pfeil") p21 "" "" "-120")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pfeil") p22 "" "" "100")
(ssadd (entlast) auswahl-satz)
)
((= ART 2)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") p14 "" "" "180")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_v") p15 "" "" "180")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") p16 "" "" "-90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_v") p17 "" "" "90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/maus") p20 "" "" "-90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/vario14") p19 "" "" "180")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/buegel") p18 "" "" "90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pfeil") p21 "" "" "70")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pfeil") p22 "" "" "-80")
(ssadd (entlast) auswahl-satz)
)
((= ART 3)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_v") p14 "" "" "")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") p15 "" "" "")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_v") p16 "" "" "90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") p17 "" "" "-90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/maus") p20 "" "" "90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/dobli-fw") p19 "" "" "90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/buegelr") p18 "" "" "-90")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pfeil") p21 "" "" "-120")
(ssadd (entlast) auswahl-satz)
(command "_insert" (strcat lw "/acadsst/zier2d/pfeil") p22 "" "" "100")
(ssadd (entlast) auswahl-satz)
)
)
(If (> K0 1)
(command "_array" auswahl-satz "" "_r" "1" m_K0 (itoa (+ L1 L3)))
)
)
;-------------------------------------------------------------------------;
; >>>>>> Programm <<<<<< ;
;-------------------------------------------------------------------------;
(defun c:b_typ4 (/ L1 L2 L3 KO ART R P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14 P15 P16 P17 P18 P19 P20)
(setvar "limcheck" 0)
(prompt "**** Bügelplatz TYP 4 *****")
(if (null m_L1) (setq m_L1 "800" )) ; Streckenabstand
(if (null m_L2) (setq m_L2 "1500" )) ; Tiefe
(if (null m_L3) (setq m_L3 "1400" )) ; Lichte Weite zum nächsten Platz
(if (null m_K0) (setq m_K0 "1" )) ; Anzahl der Plätze
(if (null m_ART) (setq m_ART "ART_1" )) ; Art
(setq auswahl-satz nil)
(Dbox)
(prompt "")
(datain)
(punkte)
(geometrie)
)
;-------------------------------------------------------------------------;
; >>>>>> Ende <<<<<< ;
;-------------------------------------------------------------------------;
Reference in New Issue View Git Blame Copy Permalink