;;Datei: wtreppe.lsp
;;WENDELTREPPENMODUL (c) 1997 Rainer Kuhn
;;Dokumentation  zum Programm in den Dateien `wt_info.txt`und `wt_help.hlp`


;;** TEIL 1*****************************************DIALOGBOXSTEUERUNG**

(defun dbox ()
  (setq ok nil)
  (while (/= ok 1)
    (setq dcldat (load_dialog "wt_dbox.dcl"))
    (if (not (new_dialog "wtreppe" dcldat))
      (exit)
      ) ;_ end of if
    (WERTVORG)
    (action_tile
      "vs"
      "(pruef1) (if (/= ko 1) (progn (WERTBER) (VORSCH)))"
      ) ;_ end of action_tile
    (action_tile
      "accept"
      "(pruef2) (if (/= ko 1) (progn (WERTBER) (done_dialog 1)))"
      )                                 ;[ggf.ok=1]
    (action_tile "pw" "(WETSP) (done_dialog 2)") ;[ok=2]
    (action_tile "help" "(WERTSP) (done_dialog 3)") ;[ok=3]
    (action_tile "cancel" "(done_dialog 0)") ;[ok=0]
    (setq ok (start_dialog))
    (unload_dialog dcldat)
    (DBOXOK)
    ) ;_ end of while
  )                                     ;end

;;------------------------------------------------**DBOX-AUSTIEGSABFRAGE /PUNKTWAHL **

(defun dboxok ()
  (cond ((= ok 0)                       ;[-Abbruch-]
         (progn (setq wendfehl "") (exit))
         )
        ((= ok 2)                       ;[-Punktwahl-]
         (setq M (getpoint "\n>Mittelpunkt wählen: ")
               x (car M)
               y (cadr M)
               z (caddr M)
               ) ;_ end of setq
         )
        ((= ok 3)                       ;[-Hilfe-]
         (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)
        ) ;_ end of progn
      ) ;_ end of if
    (if (and (= vorg1 "vgt") (= gt 0))
      (progn
        (alert "Grundrißteilung muss >0 sein !")
        (mode_tile "gt" 2)
        (setq ko 1)
        ) ;_ end of progn
      ) ;_ end of if
    )                                   ;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)
        ) ;_ end of progn
      ) ;_ end of if
    (if (and (equal "" blnpo) (/= ko 1))
      (progn
        (alert "Angabe des Blocknamens fuer Podest fehlt !")
        (mode_tile "blnpo" 2)
        (setq ko 1)
        ) ;_ end of progn
      ) ;_ end of if



    (if (and (/= nil (tblsearch "BLOCK" (strcase blnst))) (/= ko 1))
      (progn
        (alert (strcat "Blockname fuer Stufe existiert bereits."
                       "\nBitte anderen Blocknamen angeben."
                       ) ;_ end of strcat
               ) ;_ end of alert
        (mode_tile "blnst" 2)
        (setq ko 1)
        ) ;_ end of progn
      ) ;_ end of if
    (if
    (and (/= nil (tblsearch "BLOCK" (strcase blnpo))) (/= ko 1))
    (progn
      (alert (strcat "Blockname fuer Podest existiert bereits."
                     "\nBitte anderen Blocknamen angeben."
                     ) ;_ end of strcat
             ) ;_ end of alert
      (mode_tile "blnpo" 2)
      (setq ko 1)
      ) ;_ end of progn
   ) 
  (if (and (equal blnst blnpo) (/= ko 1))
    (progn
      (alert
        (strcat "Blocknamen fuer Stufe und Podest sind gleich."
                "\nBitte unterschiedliche Blocknamen angeben."
                ) ;_ end of strcat
        ) ;_ end of alert
      (mode_tile "blnpo" 2)
      (setq ko 1)
      ) ;_ end of progn
    ) ;_ end of if
  )                                     ;end


;;------------------------------------------------------------**DBOX-DESAKTIVIERUNGSFUNKTIONEN**


(defun dvew ()
  (mode_tile "weig" 0)
  (mode_tile "weig" 2)
  (set_tile "gt" "")
  (mode_tile "gt" 1)
  (mode_tile "anp2" 0)
  ) ;_ end of defun
(defun dvgt ()
  (mode_tile "gt" 0)
  (mode_tile "gt" 2)
  (set_tile "weig" "")
  (mode_tile "weig" 1)
  (mode_tile "anp2" 1)
  ) ;_ end of defun
(defun dvtm ()
  (mode_tile "s0" 2)
  (set_tile "gt" "")
  (mode_tile "gt" 1)
  (set_tile "weig" "")
  (mode_tile "weig" 1)
  (mode_tile "anp2" 1)
  ) ;_ end of defun
(defun danw ()
  (mode_tile "wang" 0)
  (mode_tile "wang" 2)
  (set_tile "waug" "")
  (mode_tile "waug" 1)
  ) ;_ end of defun
(defun dauw ()
  (mode_tile "waug" 0)
  (mode_tile "waug" 2)
  (set_tile "wang" "")
  (mode_tile "wang" 1)
  ) ;_ end of defun


;;-------------------------------------------------------**VORH.WERTE DBOX ZUWEISEN**


(defun wertvorg ()
  (if (/= nil richt)
    (set_tile "richt" richt)
    ) ;_ end of if
  (if (/= nil trtyp)
    (set_tile "trtyp" trtyp)
    ) ;_ end of if
  (if (/= nil znart)
    (set_tile "znart" znart)
    ) ;_ end of if
  (if (/= nil h)
    (set_tile "h" (rtos h))
    ) ;_ end of if
  (if (/= nil d)
    (set_tile "d" (rtos d))
    ) ;_ end of if
  (if (/= nil hs)
    (set_tile "hs" (rtos hs))
    ) ;_ end of if
  (if (/= nil s0)
    (set_tile "s0" (rtos s0))
    ) ;_ end of if
  (if (/= nil di)
    (set_tile "di" (rtos di))
    ) ;_ end of if
  (if (/= nil hg)
    (set_tile "hg" (rtos hg))
    ) ;_ end of if
  (if (/= nil wpg)
    (set_tile "wpg" (rtos wpg))
    ) ;_ end of if
  (if (/= nil x)
    (set_tile "x" (rtos x))
    ) ;_ end of if
  (if (/= nil y)
    (set_tile "y" (rtos y))
    ) ;_ end of if
  (if (/= nil z)
    (set_tile "z" (rtos z))
    ) ;_ end of if
  (if (/= nil lname)
    (set_tile "lname" lname)
    ) ;_ end of if
  (if (/= nil lfarb)
    (set_tile "lfarb" lfarb)
    ) ;_ end of if
  (if (/= nil blnst)
    (set_tile "blnst" blnst)
    ) ;_ end of if
  (if (/= nil blnpo)
    (set_tile "blnpo" blnpo)
    ) ;_ end of if
  (if (/= nil gt)
    (set_tile "gt" (rtos gt))
    ) ;_ end of if
  (if (/= nil wang)
    (set_tile "wang" (rtos wang))
    ) ;_ end of if
  (if (/= nil waug)
    (set_tile "waug" (rtos waug))
    ) ;_ end of if
  (if (/= nil weig)
    (set_tile "weig" (rtos weig))
    ) ;_ end of if
  (if (/= nil vorg2)
    (set_tile "vorg2" vorg2)
    ) ;_ end of if
  (if (equal vorg2 "auw")
    (DAUW)
    (DANW)
    ) ;_ end of if
  (if (/= nil vorg1)
    (set_tile "vorg1" vorg1)
    ) ;_ end of if
  (cond ((equal vorg1 "vgt") (DVGT))
        ((equal vorg1 "vtm") (DVTM))
        (t (DVEW))
        ) ;_ end of cond

  (if (/= nil anp1)
    (set_tile "anp1" anp1)
    ) ;_ end of if
  (if (/= nil anp2)
    (set_tile "anp2" anp2)
    ) ;_ end of if
  (if (and (= ok 2) (/= nil nvs))
    (VORSCH)
    ) ;_ end of if
  )                                     ;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 of setq
  )                                     ;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))
    ) ;_ end of if
  (if (/= nil wang)
    (set_tile "wang_vs" (rtos wang))
    ) ;_ end of if
  (if (/= nil waug)
    (set_tile "waug_vs" (rtos waug))
    ) ;_ end of if
  (if (/= nil weig)
    (set_tile "weig_vs" (rtos weig))
    ) ;_ end of if
  (if (/= nil trm)
    (set_tile "trm" (rtos trm))
    ) ;_ end of if
  (set_tile "warn" warn)
  )                                     ;end


;;**TEIL 2 **************************************************WERTEBERECHNUNG**


(defun wertber ()
  (WERTSP)
  (WINKUM)
  (setq weig (abs weig))
  (setq ri (/ di 2)                     ;[-Vorab-Wertzuweisungen-]
        r  (/ d 2)
        ll 25.0                         ;[*Vorgabe: Abstand Lauflinie-AK Treppe 25cm*]
        rl (- r ll)
        ) ;_ end of setq
  (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)))
          ) ;_ end of cond
    ) ;_ end of if
  (setq anz1 (- anz 1)
        s    (/ h anz)
        ) ;_ end of setq
  (cond ((equal vorg1 "vew") (BEWEVEW)) ;[-optionale Berechnungswege-)
        ((equal vorg1 "vgt") (BEWEVGT))
        ((equal vorg1 "vtm") (BEWEVTM))
        ) ;_ end of cond



  (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))
             ) ;_ end of if
           (setq anz2 (fix anz2)
                 hd   (- (* anz2 s) hs)
                 ) ;_ end of setq
           ) ;_ end of progn
    ) ;_ end of if
  (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))
        ) ;_ end of setq
  (if (equal richt "re")
    (setq ws (- 0 ws)
          wp (- 0 wp)
          ) ;_ end of setq
    ) ;_ end of if
  (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 !*")
    ) ;_ end of if
  (if (or (> 23 a) (> a 37))
    (setq warn "*Auftritt nicht 23-37 cm !*")
    ) ;_ end of if
  (if (/= s0 s)
    (setq warn "*Steigungsvorgabe wurde veraendert*")
    ) ;_ end of if
  (if (or (> 59 trm) (> trm 65))
    (setq warn "*Treppenmass nicht 59-65 cm !*")
    ) ;_ end of if
  (if (< hd 210)
    (setq warn "*Durchgangshoehe < 210 cm !*")
    ) ;_ end of if
  (if (= nil warn)
    (setq warn "keine")
    ) ;_ end of if
  )                                     ;end


                                        ;-------------------------------------------------**WINKELUMRECHNUNG 0 <=w<360**


(defun winkum ()
  (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)
        ) ;_ end of setq
  (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)))
          ) ;_ end of cond
    ) ;_ end of if
  (BEWEVGT)
  )                                     ;end


;;----------------------------------------------**BERECHNUNGSWEG VORG1=GR-TEILUNG**


(defun bewevgt ()
  (setq wsg  (/ 360.0 gt)
        weig (* anz1 wsg)
        ) ;_ end of setq
  (BEWEVORG2)
  (setq ws (/ (* wsg 2 pi) 360)
        a  (* 2 (* (sin (/ ws 2)) rl))
        ) ;_ end of setq
  )                                     ;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))
        ) ;_ end of setq
  (setq gt   (/ 360.0 wsg)
        weig (* anz1 wsg)
        ) ;_ end of setq
  (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)))
               ) ;_ end of cond
         (WINKUM)
         )
        ((equal vorg2 "auw")            ;[-Vorgabe: Austrittswinkel-]
         (cond ((equal richt "li") (setq wang (- waug weig)))
               ((equal richt "re") (setq wang (+ waug weig)))
               ) ;_ end of cond
         (WINKUM)
         )
        ) ;_ end of cond
  )                                     ;end


;;**TEIL 3*******************************************ZEICHNUNGS-STEUERUNG**


(defun zeichnung ()
  (command "apunkt"
           '(1 -1 1)                    ;[-Vorbereitung-]
           "kreis"
           M
           r
           "kreis"
           (list x y (+ z h (/ hg 2)))
           r
           "zoom"
           "grenzen"
           ) ;_ end of command
  (entdel (entlast))
  (entdel (entlast))
  (command "-layer"   "n"       lname     "fa"      lfarb     lname
           ""        "-layer"   "n"       "trp_konst"         "fa"
           61        "trp_konst"         "lt"      "punkt"   "trp_konst"
           ""
           ) ;_ end of command
  (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))
        ) ;_ end of if
      (command "kreis"
               M
               (/ di 2)
               "eigändr"
               (entlast)
               ""
               "o"
               hsp
               ""
               ) ;_ end of command
      ) ;_ end of progn
    ) ;_ end of if
  (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]
    ) ;_ end of if
  (setq MS0  M
        w1   0
        awsr nil
        awsf nil
        awsg nil
        ) ;_ end of setq
  (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.]
    ) ;_ end of if
  (command "linie" EI1 EA1 "")
  (setq awsr (ssget "l"))
  (command "linie" EI2 EA2 "")
  (ssadd (entlast) awsr)
  (command "bogen" "z" MS0 EI1 EI2)
  (ssadd (entlast) awsr)
  (command "bogen" "z" MS0 EA1 EA2)
  (ssadd (entlast) awsr)
  (command "eigändr" awsr "" "o" (- 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)
          ) ;_ end of setq
    (command "3dfläche" "u" EIF1 "u" EAF1 "u" EAF2 "u" EIF2 "")
                                        ;              (command "3dfl?che" EIF1 EAF1 EAF2 EIF2 "") ;[*Darst.-Option*]
    (ssadd (entlast) awsf)
    (command "_.copy" (entlast) "" MS0 (list x y (- z hs)))
    (setq wf1 wf2)
    ) ;_ end of repeat


  (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))
          ) ;_ end of if
        ) ;_ end of progn
      (progn
        (GELPODR)
        (if (equal trtyp "wt")
          (GELPODI)
          ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of if
  (if (equal blvar "stufe")             ;[-Def.Block-]
    (setq blname blnst)                 ; [Stufe]
    (setq blname blnpo)                 ; [Podest]
    ) ;_ end of if
  (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)
        ) ;_ end of setq
  (repeat nf
    (setq GP1 GP2
          wgp (+ wgp (/ ws nf))
          zgp (+ zgp (/ s nf))
          MGP (list x y zgp)
          GP2 (polar MGP wgp rg)
          ) ;_ end of setq
    (GELHANDL)                          ;[-Handlauf-]
    (if (and (= rg r) (= (/ ng 2) (fix (/ ng 2)))) ;[-Gelaenderstaebe-]
      (progn (command
               "punkt"
               (list (car GP2) (cadr GP2) (- (caddr GP2) 15))
               "eigändr"
               (entlast)
               ""
               "o"
               (- (- zgp z 15))
               ""
               ) ;_ end of command
             (ssadd (entlast) awsg)
             ) ;_ end of progn
      ) ;_ end of if
    (setq ng (+ ng 1))
    )                                   ;[-Gelaenderpfosten-]
  (command "kreis"
           GP2
           1.0
           "eigändr"
           (entlast)
           ""
           "o"
           (- (+ hg s hs))
           ""
           ) ;_ end of command
  (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)
        ) ;_ end of setq
  (GELHANDL)                            ;[-Handlauf-]
                                        ;[-Gelaenderpfosten-]
  (command "kreis"
           GP2
           1.0
           "eigändr"
           (entlast)
           ""
           "o"
           (- (+ hg hs))
           ""
           ) ;_ end of command
  (ssadd (entlast) awsg)
  (repeat (fix ls)
    (if (= (/ ng 25) (fix (/ ng 25)))
      (progn (setq rg  (- rg 25)
                   GP2 (polar MGP wgp rg)
                   ) ;_ end of setq
             (command
               "punkt"
               (list (car GP2) (cadr GP2) (- (caddr GP2) 15))
               "eigändr"
               (entlast)
               ""
               "o"
               (- (- hg 15))
               ""
               ) ;_ end of command
             (ssadd (entlast) awsg)
             ) ;_ end of progn
      ) ;_ end of if
    (setq ng (+ ng 1))
    ) ;_ end of repeat
  )                                     ;end












;;---------------------------------------------------------**BLOCKDEF.:INNEN-GELAENDER PODEST**


(defun gelpodi ()
  (setq wgp w1
        ng  1.0
        GP2 (polar MGP wgp ri)
        ) ;_ end of setq
  (repeat nf
    (setq GP1 GP2
          wgp (+ wgp (/ wp nf))
          GP2 (polar MGP wgp ri)
          ) ;_ end of setq
    (GELHANDL)                          ;[-Handlauf-]
    (if (= (/ ng 3) (fix (/ ng 3)))     ;[-Gelaenderstaebe-]
      (progn (command
               "punkt"
               (list (car GP2) (cadr GP2) (- (caddr GP2) 15))
               "eigändr"
               (entlast)
               ""
               "o"
               (- (- zgp z 15))
               ""
               ) ;_ end of command
             (ssadd (entlast) awsg)
             ) ;_ end of progn
      ) ;_ end of if
    (setq ng (+ ng 1))
    )                                   ;[-Gelaenderpfosten-]
  (command "kreis"
           GP2
           1.0
           "eigändr"
           (entlast)
           ""
           "o"
           (- (+ hg hs))
           ""
           ) ;_ end of command
  (ssadd (entlast) awsg)
  )                                     ;end


;;----------------------------------------------------**BLOCKDEF.:GELAENDER HANDLAUF**


(defun gelhandl ()
  (command "linie" GP1 GP2 "")          ;[-Handlauflinien-]
  (ssadd (entlast) awsg)
  (command "_.copy" (entlast) "" MGP (list x y (- zgp 15)))
  (ssadd (entlast) awsg)
  (command "bks"
           "zachse"
           GP1
           GP2                          ;[-Handlauf als Rohr-]
           "kreis"
           (trans GP1 0 1)
           1.5
           "eigändr"
           (entlast)
           ""
           "o"
           (distance GP1 GP2)
           ""
           "bks"
           "welt"
           ) ;_ end of command
  (ssadd (entlast) awsg)
  )                                     ;end


;;---------------------------------------------------------**TREPPE ZEICHNEN**


(defun treppe ()
  (setq wef wan
        zef z
        nt  1
        ) ;_ end of setq
  (repeat anz
    (setq zef  (+ zef s)
          MS   (list x y zef)
          wefg (/ (* wef 360) (* 2 pi))   ;[Einfuegewinkel in Grad]
          ) ;_ end of setq
    (if (and (equal znart "mg") (= nt 1)) ;[-Gelaenderanfang-]
      (progn
        (command "kreis"
                 (polar (list x y (+ zef hg)) wef r)
                 1.0
                 "eigändr"
                 (entlast)
                 ""
                 "o"
                 (- (+ hg s))
                 ""
                 ) ;_ end of command
        (if (equal trtyp "wt")
          (command "kreis"
                   (polar (list x y (+ zef hg)) wef ri)
                   1.0
                   "eigändr"
                   (entlast)
                   ""
                   "o"
                   (- (+ hg s))
                   ""
                   ) ;_ end of command
          ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
    (if (not (= nt anz))                ;[-Stufen/Pod.-]
      (command "einfüge" blnst MS "1" "1" wefg) ;[Stufe]
      (command "einfüge" blnpo MS "1" "1" wefg) ;[Podest]
      ) ;_ end of if
    (setq wef (+ wef ws)
          nt  (+ nt 1)
          ) ;_ end of setq
    ) ;_ end of repeat
  (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)
        ) ;_ end of setq
  (setvar "clayer" "trp_konst")
  (command
    "linie"
    PD1
    PD2
    ""                                  ;[-Durchg.hoehe-]
    "bogen"
    "z"
    M
    (polar M wef r)
    (polar M (- wef 0.01) r)            ;[-Basiskreis-]
    "bogen"
    "z"
    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 "linie" 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 " ")
      ) ;_ end of princ
    (princ wendfehl)
    ) ;_ end of if
  (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
        ) ;_ end of setq
  (setq cmdecho0  (getvar "cmdecho")
        blipmode0 (getvar "blipmode")
        angbase0  (getvar "angbase")
        osmode0   (getvar "osmode")
        clayer0   (getvar "clayer")
        viewdir0  (getvar "viewdir")
        ) ;_ end of setq
  (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
;|«Visual LISP© Format Options»
(72 2 40 1 T "end of " 60 9 0 0 0 nil T nil T)
;*** KEINEN Text unterhalb des Kommentars hinzufügen! ***|;