(defun dbox () (setq ok nil) (while (/= ok 1) (setq dcldat (load_dialog "wt_dbox.dcl")) (if (not (new_dialog "wtreppe" dcldat)) (exit)) (WERTVORG) (action_tile "vs" "(PRUEF1) (if (/= ko 1) (progn (WERTBER) (VORSCH)))") (action_tile "accept" "(PRUEF2) (if (/= ko 1) (progn (WERTBER) (done_dialog 1)))") (action_tile "pw" "(WETSP) (done_dialog 2)") (action_tile "help""(WERTSP) (done_dialog 3)") (action_tile "cancel" "(done_dialog 0)") (setq ok (start_dialog)) (unload_dialog dcldat) (DBOXOK) ) );end ;;------------------------------------------------**DBOX-AUSTIEGSABFRAGE /PUNKTWAHL ** (defun dboxok () (cond( (= ok 0) (progn (setq wendfehl "") (exit)) ) ( (= ok 2) (setq M (getpoint "\n>Mittelpunkt wählen: ") x (car M) y (cadr M) z (caddr M) ) ) ( (= ok 3) (acad_helpdlg "wt_help.hlp" "") ) ) );end ;;-------------------------------------------------------**DBOX-FEHLEINGABEPRUEFUNG** (defun pruef1 () (WERTSP) (setq ko nil) (if (and (= vorg1 "vew") (= weig 0)) (progn (alert "Eingeschlossener Winkel muss >0 sein !") (mode_tile "weig" 2) (setq ko 1) ) ) (if (and (= vorg1 "vgt") (= gt 0)) (progn (alert "Grundrißteilung muss >0 sein !") (mode_tile "gt" 2) (setq ko 1) ) ) );end ;;---------------------------------------------------------------**DBOX-BLOCKNAMENSPRUEFUNG** (defun pruef2() (PRUEF1) (if (and (equal ""blnst) (/= ko 1)) (progn (alert "Angabe des Blocknamens fuer Stufe fehlt !") (mode_tile "blnst" 2) (setq ko 1) ) ) (if (and (equal "" blnpo) (/= ko 1)) (progn (alert "Angabe des Blocknamens fuer Podest fehlt !") (mode_tile "blnpo" 2) (setq ko 1) ) ) (if (and (/= nil (tblsearch "BLOCK" (strcase blnst))) (/= ko 1)) (progn (alert (strcat "Blockname fuer Stufe existiert bereits." "\nBitte anderen Blocknamen angeben.")) (mode_tile "blnst" 2) (setq ko 1) ) ) (if (and (/= nil (tblsearch "BLOCK" (strcase blnpo))) (/= ko 1)) (progn (alert (strcat "Blockname fuer Podest existiert bereits." "\nBitte anderen Blocknamen angeben.")) (mode_tile "blnpo" 2) (setq ko 1) ) ) (if (and (equal blnst blnpo) (/= ko 1 )) (progn (alert (strcat "Blocknamen fuer Stufe und Podest sind gleich." "\nBitte unterschiedliche Blocknamen angeben.")) (mode_tile "blnpo" 2) (setq ko 1) ) ) );end ;;------------------------------------------------------------**DBOX-DESAKTIVIERUNGSFUNKTIONEN** (defun dvew () (mode_tile "weig" 0) (mode_tile "weig" 2) (set_tile "gt""") (mode_tile "gt" 1) (mode_tile "anp2" 0) ) (defun dvgt () (mode_tile "gt" 0) (mode_tile "gt" 2) (set_tile "weig" "") (mode_tile "weig" 1) (mode_tile "anp2" 1) ) (defun dvtm () (mode_tile "s0" 2) (set_tile "gt" "") (mode_tile "gt" 1) (set_tile "weig" "") (mode_tile "weig" 1) (mode_tile "anp2" 1) ) (defun danw () (mode_tile "wang" 0) (mode_tile "wang" 2) (set_tile "waug" "") (mode_tile "waug" 1) ) (defun dauw () (mode_tile "waug" 0) (mode_tile "waug" 2) (set_tile "wang" "") (mode_tile "wang" 1) ) ;;-------------------------------------------------------**VORH.WERTE DBOX ZUWEISEN** (defun wertvorg () (if (/= nil richt) (set_tile "richt" richt)) (if (/= nil trtyp) (set_tile "trtyp" trtyp)) (if (/= nil znart) (set_tile "znart" znart)) (if (/= nil h) (set_tile "h" (rtos h))) (if (/= nil d) (set_tile "d" (rtos d))) (if (/= nil hs) (set_tile "hs" (rtos hs))) (if (/= nil s0) (set_tile "s0" (rtos s0))) (if (/= nil di) (set_tile "di" (rtos di))) (if (/= nil hg) (set_tile "hg" (rtos hg))) (if (/= nil wpg) (set_tile "wpg" (rtos wpg))) (if (/= nil x) (set_tile "x" (rtos x))) (if (/= nil y) (set_tile "y" (rtos y))) (if (/= nil z) (set_tile "z" (rtos z))) (if (/= nil lname) (set_tile "lname" lname )) (if (/= nil lfarb) (set_tile "lfarb" lfarb)) (if (/= nil blnst) (set_tile "blnst" blnst)) (if (/= nil blnpo) (set_tile "blnpo" blnpo)) (if (/= nil gt) (set_tile "gt" (rtos gt))) (if (/= nil wang) (set_tile "wang" (rtos wang))) (if (/= nil waug) (set_tile "waug" (rtos waug))) (if (/= nil weig) (set_tile "weig" (rtos weig))) (if (/= nil vorg2) (set_tile "vorg2" vorg2)) (if (equal vorg2 "auw") (DAUW) (DANW)) (if (/= nil vorg1) (set_tile "vorg1" vorg1)) (cond ((equal vorg1 "vgt") (DVGT)) ((equal vorg1 "vtm") (DVTM)) (t (DVEW)) ) (if (/= nil anp1) (set_tile "anp1" anp1)) (if (/= nil anp2) (set_tile "anp2" anp2)) (if (and (= ok 2) (/= nil nvs)) (VORSCH)) );end ;;--------------------------------------------**DBOX-WERTE SPEICHERN** (defun wertsp () (setq richt (get_tile "richt") trtyp (get_tile "trtyp") znart (get_tile "znart") h (atof (get_tile "h")) d (atof(get_tile "d")) hs (atof (get_tile "hs")) s0 (atof (get_tile "s0")) di (atof (get_tile "di")) hg (atof (get_tile "hg")) wpg (atof (get_tile "wpg")) x (atof (get_tile "x")) y (atof (get_tile "y")) z (atof (get_tile "z")) lname (get_tile "lname") lfarb (get_tile "lfarb") blnst (get_tile "blnst") blnpo (get_tile "blnpo") vorg1 (get_tile "vorg1") vorg2 (get_tile "vorg2") gt (atof (get_tile "gt")) wang (atof (get_tile "wang")) waug (atof (get_tile "waug")) weig (atof (get_tile "weig")) anp1 (get_tile "anp1") anp2 (get_tile "anp2") ) );end ;;----------------------------------------------**DBOX-VORSCHAU** (defun vorsch () (setq nvs 1) (set_tile "anz" (itoa anz)) (set_tile "anz1" (itoa anz1)) (set_tile "s" (rtos s)) (set_tile "a" (rtos a)) (set_tile "wsg" (rtos wsg)) (set_tile "hd" (rtos hd)) (set_tile "ls" (rtos ls)) (if (/= nil gt) (set_tile "gt_vs" (rtos gt))) (if (/= nil wang) (set_tile "wang_vs" (rtos wang))) (if (/= nil waug) (set_tile "waug_vs" (rtos waug))) (if (/= nil weig) (set_tile "weig_vs" (rtos weig))) (if (/= nil trm) (set_tile "trm" (rtos trm))) (set_tile "warn" warn) );end ;;**TEIL 2 **************************************************WERTEBERECHNUNG** (defun wertber () (WERTSP) (WINKUMR) (setq weig (abs weig)) (setq ri (/ di 2) ;[-Vorab-Wertzuweisungen-] r (/ d 2) ll 25.0 rl (- r ll) ) (setq anz0 (/ h s0)) ;[-Anpassung1: Steigung-] (if (equal anz0 (fix anz0)) (setq anz (fix anz0)) (cond ((equal anp1 "sgr") (setq anz (fix anz0))) ((equal anp1 "skl") (setq anz (+ (fix anz0) 1))) ) ) (setq anz1 (- anz 1) s (/ h anz) ) (cond ((equal vorg1 "vew") (BEWEVEW)) ;[-optionale Berechnungswege-) ((equal vorg1 "vgt") (BEWEVGT)) ((equal vorg1 "vtm") (BEWEVTM)) ) (setq wdhg (- 360 wpg)) ;[-Durchgangshoehe-] (if (> wdhg weig) (setq hd (- h hs)) (progn (setq anz2 (/ wdhg wsg)) (if (/= anz2 (fix anz2)) (setq anz2 (+ anz2 1))) (setq anz2 (fix anz2) hd (- (* anz2 s) hs)) ) ) (setq trm (+ (* 2 s) a) ;[-sonst.Werte/Zuweisungen-] ls (- r ri) wan (/ (* wang 2 pi) 360) wp (/ (* wpg 2 pi) 360) M (list x y z) MO (list x y (+ z h)) ) (if (equal richt "re") (setq ws (- 0 ws) wp (- 0 wp))) (WARNMELD) );end wertber ;;--------------------------------------------------**WARNMELDUNGEN FUER DBOX-VORSCHAU** (defun warnmeld () (setq warn nil) (if (or (> 14 s) (> s 21)) (setq warn "*Steigungshoehe nicht 14-21 cm !*")) (if (or (> 23 a) (> a 37)) (setq warn "*Auftritt nicht 23-37 cm !*")) (if (/= s0 s) (setq warn "*Steigungsvorgabe wurde veraendert*")) (if (or (> 59 trm) (> trm 65)) (setq warn "*Treppenmass nicht 59-65 cm !*")) (if (< hd 210) (setq warn "*Durchgangshoehe < 210 cm !*")) (if (= nil warn) (setq warn "keine")) );end ;-------------------------------------------------**WINKELUMRECHNUNG 0 <=w<360** (defun winkumr () (while (< wang 0) (setq wang (+ wang 360))) (while (> wang 359.99) (setq wang (- wang 360))) (while (< waug 0) (setq waug (+ waug 360))) (while (> waug 359.99) (setq waug (- waug 360))) );end ;;-----------------------------------------------**BERECHNUNGSWEG VORG1=EING.WINKEL** (defun bewevew () (setq wsg0 (/ weig anz1) ;[-Anpassung2: eing.Winkel-] gt0 (/ 360 wsg0) ) (if (or (equal gt0 (fix gt0)) (equal anp2 "ewfi")) (setq gt gt0) (cond ((equal anp2 "agr") (setq gt (fix gt0))) ((equal anp2 "akl") (setq gt (+ (fix gt0) 1))) ) ) (BEWEVGT) );end ;;----------------------------------------------**BERECHNUNGSWEG VORG1=GR-TEILUNG** (defun bewevgt () (setq wsg (/ 360.0 gt) weig (* anz1 wsg) ) (BEWEVORG2) (setq ws (/ (* wsg 2 pi) 360) a (* 2(*(sin (/ ws 2)) rl)) ) );end ;;---------------------------------------------**BERECHNUNGSWEG VORG1=TREPPENMASS 63** (defun bewevtm () (setq a (- 63 (* 2 s)) hm (sqrt (- (expt rl 2) (expt (/ a 2) 2))) ws (* 2 (atan (/ (/ a 2) hm))) wsg (/ (* ws 360) (* 2 pi)) ) (setq gt (/ 360.0 wsg) weig (* anz1 wsg) ) (BEWEVORG2) );end ;;----------------------------------------**BERECHNUNGSWEG VORG2 (AN-/AUSTRITTSWINKEL)** (defun bewevorg2 () (cond ((equal vorg2 "anw") ;[-Vorgabe: Antrittswinkel-] (cond ((equal richt "li") (setq waug (+ wang weig))) ((equal richt "re") (setq waug (- wang weig))) ) (WINKUMR) ) ((equal vorg2 "auw") ;[-Vorgabe: Austrittswinkel-] (cond ((equal richt "li") (setq wang (- waug weig))) ((equal richt "re") (setq wang (+ waug weig))) ) (WINKUMR) ) ) );end ;;**TEIL 3*******************************************ZEICHNUNGS-STEUERUNG** (defun zeichnung () (command "_vpoint" '(1 -1 1) ;[-Vorbereitung-] "_circle" M r "_circle" (list x y (+ z h (/ hg 2))) r "zoom" "_e" ) (entdel (entlast)) (entdel (entlast)) (command "_-layer" "_m" lname "_c" lfarb lname"" "_-layer" "_m" "trp_konst" "_c" 61 "trp_konst" "_lt" "continuous" "trp_konst" "" ) (princ "\nDefiniere Blocks...") ;[-Blockdefinition-] (setvar "clayer" "0") (setq blvar "stufe") (BLOCKDEF) ;[1Blockdef.= Stufe] (setq blvar "podest") (BLOCKDEF) ;[2Blockdef.= Podest] (setvar "clayer" lname) ;[-Zeichnungslayer-] (if (equal trtyp "sp") ;[-Spindel (ggf.)-] (progn (if (equal znart "mg") (setq hsp (+ h hg)) (setq hsp (+ h 1))) (command "_circle" M (/ di 2) "_chprop" (entlast) "" "_th" hsp "") ) ) (TREPPE) ;[-Treppe-] (KONSTR) ;[-Konstr.linien-] );end ;;----------------------------------------------------**BLOCKDEFINITION STUFE/PODEST** (defun blockdef () (if (equal blvar "stufe") (setq w2 ws nf 6) ;[Stufe] (setq w2 wp nf 12) ;[Podest] ) (setq MS0 M w1 0 awsr nil awsf nil awsg nil) (if (equal richt "re") ;[-"Rahmen"-] (setq EI2 (polar MS0 w1 ri) EI1 (polar MS0 w2 ri) EA2 (polar MS0 w1 r) EA1 (polar MS0 w2 r) ) ;[rechtsdr.] (setq EI1 (polar MS0 w1 ri) EI2 (polar MS0 w2 ri) EA1 (polar MS0 w1 r) EA2 (polar MS0 w2 r) ) ;[linkddr.] ) (command "_line" EI1 EA1 "") (setq awsr (ssget "l")) (command "_line" EI2 EA2 "") (ssadd (entlast) awsr) (command "_arc" "_c" MS0 EI1 EI2) (ssadd (entlast) awsr) (command "_arc" "_c" MS0 EA1 EA2) (ssadd (entlast) awsr) (command "_chprop" awsr "" "_th" (- 0 hs) "") (setq awsf (ssadd) wf1 w1) ;[-3DFlaechen-] (repeat nf (setq wf2 (+ wf1 (/ w2 nf)) EIF1 (polar MS0 wf1 ri) EAF1 (polar MS0 wf1 r) EIF2 (polar MS0 wf2 ri) EAF2 (polar MS0 wf2 r) ) (command "_3dface" "_i" EIF1 "_i"EAF1 "_i" EAF2 "_i" EIF2 "") ;(command "_3dface" EIF1 EAF1 EAF2 EIF2 "") ;[*Darst.-Option*] (ssadd (entlast) awsf) (command "_copy" (entlast) "" MS0 (list x y (- z hs))) (setq wf1 wf2) ) (setq awsg (ssadd)) ;[-Gelaender-] (if (equal znart "mg") (if (equal blvar "stufe") (progn (setq rg r) (GELSTU) (if (equal trtyp "wt") (progn (setq rg ri) (GELSTU))) ) (progn (GELPODR) (if (equal trtyp "wt") (GELPODI)) ) ) ) (if (equal blvar "stufe") ;[-Def.Block-] (setq blname blnst) ; [Stufe] (setq blname blnpo); [Podest] ) (command "_-block" blname MS0 awsr awsf awsg "") );end blockdef ;;--------------------------------------------------------**BLOCKDEF.: GELAENDERSTUFE (defun gelstu () (setq wgp w1 zgp (+ z hg) ng 1.0 MGP (list x y zgp) GP2 (polar MGP wgp rg) ) (repeat nf (setq GP1 GP2 wgp (+ wgp (/ ws nf)) zgp (+ zgp (/ s nf)) MGP (list x y zgp) GP2 (polar MGP wgp rg) ) (GELHANDL) ;[-Handlauf-] (if (and (= rg r) (= (/ ng 2) (fix (/ ng 2)))) ;[-Gelaenderstaebe-] (progn (command "_point" (list (car GP2) (cadr GP2) (- (caddr GP2) 15)) "_chprop" (entlast) "" "_th" (- (- zgp z 15)) "" ) (ssadd (entlast) awsg) ) ) (setq ng (+ ng 1)) ) ;[-Gelaenderpfosten-] (command "_circle" GP2 1.0 "_chprop" (entlast) "" "_th" (- (+ hg s hs)) "") (ssadd (entlast) awsg) );end ;;------------------------------------------------------------**BLOCKDEF.:RADIAL-GELAENDER PODEST** (defun gelpodr () (setq wgp w2 zgp (+ z hg) MGP (list x y zgp) ng 1.0 rg r GP1 (polar MGP wgp ri) GP2 (polar MGP wgp r) ) (GELHANDL) ;[-Handlauf-] ;[-Gelaenderpfosten-] (command "_circle" GP2 1.0 "_chprop" (entlast) "" "_th" (- (+ hg hs)) "") (ssadd (entlast) awsg) (repeat (fix ls) (if (= (/ ng 25) (fix (/ ng 25))) (progn (setq rg (- rg 25) GP2 (polar MGP wgp rg)) (command "_point" (list (car GP2) (cadr GP2) (- (caddr GP2) 15)) "_chprop" (entlast) "" "_th" (- (- hg 15)) "" ) (ssadd (entlast) awsg) ) ) (setq ng (+ ng 1)) ) );end ;;---------------------------------------------------------**BLOCKDEF.:INNEN-GELAENDER PODEST** (defun gelpodi () (setq wgp w1 ng 1.0 GP2 (polar MGP wgp ri)) (repeat nf (setq GP1 GP2 wgp (+ wgp (/ wp nf)) GP2 (polar MGP wgp ri) ) (GELHANDL) ;[-Handlauf-] (if (= (/ ng 3) (fix (/ ng 3))) ;[-Gelaenderstaebe-] (progn (command "_point" (list (car GP2) (cadr GP2) (- (caddr GP2) 15)) "_chprop" (entlast) "" "_th" (- (- zgp z 15)) "" ) (ssadd (entlast) awsg) ) ) (setq ng (+ ng 1)) ) ;[-Gelaenderpfosten-] (command "_circle" GP2 1.0 "_chprop" (entlast) "" "_th" (- (+ hg hs)) "") (ssadd (entlast) awsg) );end ;;----------------------------------------------------**BLOCKDEF.:GELAENDER HANDLAUF** (defun gelhandl () (command "_line" GP1 GP2 "") ;[-Handlauflinien-] (ssadd (entlast) awsg) (command "_copy" (entlast) "" MGP (list x y (- zgp 15))) (ssadd (entlast) awsg) (command "_ucs" "_n" "_za" GP1 GP2 ;[-Handlauf als Rohr-] "_circle" (trans GP1 0 1) 1.5 "_chprop" (entlast) "" "_th" (distance GP1 GP2) "" "_ucs" "_w" ) (ssadd (entlast) awsg) );end ;;---------------------------------------------------------**TREPPE ZEICHNEN** (defun treppe () (setq wef wan zef z nt 1) (repeat anz (setq zef (+ zef s) MS (list x y zef) wefg (/ (* wef 360) (* 2 pi)) ;[Einfuegewinkel in Grad] ) (if (and (equal znart "mg") (= nt 1)) ;[-Gelaenderanfang-] (progn (command "_circle" (polar (list x y (+ zef hg)) wef r) 1.0 "_chprop" (entlast) "" "_th" (- (+ hg s)) "") (if (equal trtyp "wt") (command "_circle" (polar (list x y (+ zef hg)) wef ri) 1.0 "_chprop" (entlast) "" "_th" (- (+ hg s)) "") ) ) ) (if (not (= nt anz)) ;[-Stufen/Pod.-] (command "_-insert" blnst MS "1" "1" wefg) ;[Stufe] (command "_-insert" blnpo MS "1" "1" wefg) ;[Podest] ) (setq wef (+ wef ws) nt (+ nt 1)) ) (princ "Verdecke Linien...") (command "verdeckt") );end ;;-----------------------------------------------------------**KONSTRUKTIONSLINIEN** (defun konstr () (setq PD1 (polar (list x y (- zef hs)) (+ (- wef ws) wp) r) PD2 (polar (list x y (- zef hd hs)) (+ (- wef ws) wp) r) ) (setvar "clayer" "trp_konst") (command "_line" PD1 PD2 "" ;[-Durchg.hoehe-] "_arc" "_c" M (polar M wef r) (polar M (- wef 0.01) r) ;[-Basiskreis-] "_arc" "_c" MO (polar M wef r) (polar MO (- wef 0.01) r) ;[-Treppenloch-] ) ;[*Anm.:Bogen wird im Gegensatz zum Kreis nicht verdeckt*] (if (equal trtyp "wt") (command "_line" M MO "")) ;[-Mittelachse-] (setvar "clayer" lname) );end ;;**TEIL 4*************************************************FEHLERBEHANDLUNGSFUNKTION** (defun WEND_FEHL (fmeld) (setq *error* error0) ; (command "apunkt" viewdir0) ;[*Option*] (if (= nil wendfehl) (princ (strcat "\nFehler bei Wendeltreppenfunktion: " fmeld " ")) (princ wendfehl) ) (setvar "cmdecho" cmdecho0) (setvar "blipmode" blipmode0) (setvar "angbase" angbase0) (setvar "osmode" osmode0) (setvar "clayer" clayer0) (princ) );end ;;**TEIL 5********************************************HAUPTPROGRAMM** (princ "Wendeltreppenmodul WTREPPE geladen.\n") (defun c:wtreppe (/ anz0 anz2 gt0 hm hsp r rg ri rl dcldat ko nf ng nt nvs ok zef zgp wan wdhg wef wefg wgp wp ws wsg0 w1 w2 wf1 wf2 blname blvar EI1 EI2 EA1 EA2 EIF1 EIF2 EAF1 EAF2 GP1 GP2 M MGP MO MS MS0 PD1 PD2 awsr awsf awsg );[*Anm.:sonstige Variablen nicht lokal definiert, ; da für erneuten DBox-Aufruf benoetigt*] (princ "\nWENDELTREPPENMODUL\n") (setq error0 *error* *error* WEND_FEHL ;[*zum Abschalten der Fehlerkt.';'davor*] wendfehl nil ) (setq cmdecho0 (getvar "cmdecho") blipmode0 (getvar "blipmode") angbase0 (getvar "angbase") osmode0 (getvar "osmode") clayer0 (getvar "clayer") viewdir0 (getvar "viewdir") ) (setvar "cmdecho" 0) (setvar "blipmode" 0) (setvar "angbase" 0) (setvar "osmode" 0) (DBOX) (ZEICHNUNG) ; (command "apunkt" viewdir0 "verdeckt") ;[*Option*] (setvar "cmdecho" cmdecho0) (setvar "blipmode" blipmode0) (setvar "angbase" angbase0) (setvar "osmode" osmode0) (setvar "clayer" clayer0) (setq *error* error0) (princ) );end wtreppe