lisp draait in inch, metric zou handiger zijn

[vasperos]

ik heb een lisp programmatje gevonden voor een trap te tekenen.
Het enige probleem is dat hij in inch is.
Hoe krijg ik hem omgezet naar cm?
Ik veronderstel dat het ergens een variable is?

Code Selecteer Uitklappen



;-> define internal error handler: if cancelled or on error,
;-> display error msg. and exit

(defun str_err (msg)
     
     (if (/= msg nil)
       (progn
         (princ (strcat "\nError: " msg )) (princ)
         (str_normex)
         (str_varnil)
       ) ;progn
     ) ;if
) ;defun

;;;----------------------------------------------------------------------------;;;

;-> resets ACAD variables (normal exit)

(defun str_normex ()
   
    (setvar "lunits" slun)
    (setvar "luprec" slprec)
    (setvar "osmode" sosm)
    (setvar "plinewid" splw)
    (setvar "cmdecho" scmd)
    (setvar "textsize" stxtsz)
    (setq *error* old_error)
    (setq old_error nil)

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> set all stairs.lsp variables to nil   

(defun str_varnil ()
   
    (foreach varlst '(ff th apx dvsr tavg mintrd midtrd maxtrd
                      nzh nzl slun slprec sosm splw nor lft rt dn
                      rht trdflt tsiz tdir nostp step nostp rnded
                      dflts pt1 pt2 pt3 pt4 pt5 strshp scmd ang
                      dist horiz botris stxtsz txtpt prntxt)
      (set varlst nil)
    ) ;foreach
    (princ)
) ;defun

;;;---------------------------------------------------------------------------;;;

;-> define math functions

(defun dtr (a)
    (* pi (/ a 180.0))
)   

(defun tan (a)
    (/ (sin a) (cos a))
)

(defun rnd (n / fn sfn)
    (setq fn (fix n))
    (setq sfn (- n fn))
      (if (>= sfn 0.5)
        (setq n (+ fn 1))
        (setq n fn)
      ) ;if
) ; defun

;;;---------------------------------------------------------------------------;;;


(defun str_setup ()

;-> set variables
   
    (str_varnil)                       ;-> set stairs.lsp variables to nil
    (setq old_error *error*            ;-> trap old error handler
       *error* str_err)                ;-> set error handler
    (setq slun (getvar "lunits"))     
    (setvar "lunits" 2                 ;-> decimal
      )
    (setq slprec (getvar "luprec"))
    (setvar "luprec" 4                 ;-> four decimal places
      )
    (setq splw (getvar "plinewid"))
    (setvar "plinewid" 0.0             ;-> set polyline width
      )
    (setq sosm (getvar "osmode")
      )
    (setq scmd (getvar "cmdecho"))
    (setvar "cmdecho" 0                ;-> set cmdecho off
      )
    (setq stxtsz (getvar "textsize"))
    (setvar "textsize" 6               ;-> set textsize to 6
      )

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> call other info functions

(defun str_info ()
   
    (str_ht)         ;1
    (str_dir)        ;2
    (str_shp)        ;3
    (str_default)    ;4
    (str_ris_ht)     ;5
    (str_trd_siz)    ;6
    (str_trd_th)     ;7     
    (str_nozlen)     ;8

);defun   
   
;;;---------------------------------------------------------------------   

;->determine total height #1 from info
   
(defun str_ht ( / ff)              ;-> first floor   
   
    (princ "\nDetermine Overall Height...")
    (setvar "osmode" 512)          ;-> set osnap to nearest
    (initget 9)
    (setq ff (getpoint "\nPick Any Point On The Lower Level: "))
    (setvar "osmode" 33)
    (initget 9)
    (setq pt1 (getpoint "\nPick The Top Step: "))
    (setq th (-(cadr pt1)(cadr ff)))
    (setq txtpt (polar pt1 (/ pi 2.0) 36))

);defun   
   
;;;-------------------------------------------------------------------------   
   
;->determine stair direction #2 from info

(defun str_dir ()

    (princ "\nDetermine Stair Direction...")
    (initget 1 "Left Right")
    (setq tdir (getkword "\nStairs Go Down To Right or Left? (R or L) "))
      (if (= (substr tdir 1 1) "R")     
          (setq tdir nil)
          (setq tdir 1)
      ) ;if
) ;defun   

;;;---------------------------------------------------------------------

;->determine stair shape #3 from info
   
(defun str_shp ()   
   
    (princ "\nDetermine Nosing Shape...")
    (initget 7 "Square Round")
    (setq strshp (getkword "\nDo You Want Square Or Round Nose? (S or R) "))
      (if (= (substr strshp 1 1) "S")
        (setq strshp nil)
        (setq strshp 1)
      ) ;if
) ;defun   

;;;-------------------------------------------------------------------------;;;   

;->accept defaults or customize #4 from info

(defun str_default ()

    (princ "\nSelect Design Method...")
    (initget 6 "Customize Defaults")
    (setq dflts (getkword "\nCustomize or Defaults (C or D) <Defaults>"))
      (if (or
            (= dflts nil)
            (= (substr dflts 1 1) "D")
          ) ;or
            (setq dflts 1)
            (setq dflts nil)
      ) ;if
) ;defun

;;;-------------------------------------------------------------------------;;;

;->determine riser height #5 from info

(defun str_ris_ht ( / dvsr    ;->desired riser height (divisor)
                      apx
                      rnded)  ;->rounded apx
   
    (princ "\nDetermine Riser Height...")
    (if dflts
      (progn                                     ;then
        (setq nor (rnd (/ th 7)))
        (setq rht (/ th nor))
      ) ;progn then
      (progn                                     ;else
        (initget 6)
        (setq dvsr (getreal (strcat
          "\nDesired Riser Height Is: <7\"> " )))
            (if (= dvsr nil) (setq dvsr 7)
            ) ;if
        (setq apx(/ th dvsr))
          (princ (strcat
          "\nTotal Height Divided By " (rtos dvsr 4 4) " is: " (rtos apx))
          ) ;princ
        (setq rnded (rnd apx))
        (initget 6)
        (setq nor (getint (strcat
          "\nHow Many Risers Do You Want?: <"(itoa rnded)"> ")))
          (if (= nor nil) (setq nor rnded)
          ) ;if
        (setq rht (/ th nor))
          (princ (strcat "\nRiser Height Is: " (rtos rht 5 5) "\""))
      ) ;progn else
    ) ;if
) ;defun

;;;------------------------------------------------------------------------

;->determine tread size #6 from info

(defun str_trd_siz ( / horiz       ;-> horizontal constraints y or n
                       botris      ;-> point for bottom riser
                       tavg        ;-> average of first three tests
                       mintrd      ;-> tread size @ 35 degrees
                       midtrd      ;->   "    "   @ 32.5  "
                       maxtrd      ;->   "    "   @ 30    "
                       trdflt)     ;-> default tread size

;->if constrained horizontally, set tread size to fit

    (princ "\nDetermine Tread And Nosing Size...")
    (if (not dflts)                               ;customize
      (progn                                      ;then
        (initget 6 "Yes No")
        (setq horiz (getkword
          "\nHorizontal Constraints? (Y or N): <N>"))
          (if (or
              (= horiz nil)
              (= (substr horiz 1 1) "N")
              ) ;or
                (setq horiz nil)
                (setq horiz 1)
          ) ;if
      ) ;progn then
    ) ;if not dflts   
   
    (if horiz
          (progn                                   ;then
            (setvar "osmode" 33)
            (initget 9)                           
            (setq botris (getpoint "\nPick Point For Bottom Riser:"))
            (setq tsiz (abs (/ (- (car pt1) (car botris)) (- nor 1))))
          ) ;progn then

;->first three rules of stairs average   
   
      (progn                                     ;else
      (setq tavg (/ (+ (- 17.25 rht) (- 24.5 rht) (/ 72.5 rht)) 3))
   
;->test for angle of stairs and set tread size default   

      (setq mintrd (/ rht (tan (dtr 35))))   
      (setq midtrd (/ rht (tan (dtr 32.5))))
      (setq maxtrd (/ rht (tan (dtr 30))))   
        (if (and
             (>= tavg mintrd)
             (<= tavg maxtrd)
            ) ;and
             (setq trdflt tavg)
             (setq trdflt midtrd)
        ) ;if
      (if dflts
        (setq tsiz trdflt)                         ;then
        (progn                                     ;else
     
;->display range of tread sizes for 30-35 degree stair

     (princ "\nFor Stair Between 30 and 35 Degrees...")
     (princ (strcat
     "\nTread Should Be: " (rtos mintrd 5 4) "\" to " (rtos maxtrd 5 4) "\"")
      ) ;princ
      (initget 6)
      (setq tsiz (getreal (strcat
        "\nEnter Tread Size In Inches: <" (rtos trdflt 5 4) "\">")))
          (if (= tsiz nil) (setq tsiz trdflt)
          ) ;if
        ) ;progn else
      ) ;if dflts
     ) ;progn
    ) ;if horiz   

;->display angle of stairs       

      (princ (strcat
        "\nAngle Of Stairs Is: " (angtos (atan rht tsiz) 0 2) " Degrees")   
        ) ;princ   

) ;defun

;;;---------------------------------------------------------------------------;;;
   
;->determine tread thickness #7 from info

(defun str_trd_th ()

    (if (and
         (= dflts 1)
         (not strshp)
        ) ;and
         (setq nzh 1.5)
    ) ;if
   
    (if (and
         (not dflts)
         (not strshp)
        ) ;and
         (progn                                  ;then
           (initget 4)
           (setq nzh (getreal (strcat
             "\nEnter Tread Thickness In Inches: <1 1/2\"> ")))
           (if (= nzh nil) (setq nzh 1.5))
         ) ;progn then
    ) ;if

    (if (and
          (= dflts 1)
          (= strshp 1)
        ) ;and
          (setq nzh 1.25)
    ) ;if

    (if (and
          (not dflts)
          (= strshp 1)
        ) ;and
          (progn                                 ;then
            (initget 6)
            (setq nzh (getreal (strcat
                "\nEnter Tread Thickness In Inches: <1 1/4\"> ")))
            (if (= nzh nil) (setq nzh 1.25))
          ) ;progn then
    ) ;if
) ;defun

;;;--------------------------------------------------------------------------
   
;->determine nosing overhang #8 from info
   
(defun str_nozlen ()   

    (if dflts
      (setq nzl 1.25)                            ;then
        (progn                                   ;else
          (if (and
              (not dflts)
              (not strshp)
              ) ;and
              (initget 4)
          ) ;if
          (if (and
              (not dflts)
              (= strshp 1)
              ) ;and   
              (initget 6)
          ) ;if     
            (setq nzl (getreal (strcat
              "\nEnter Nosing Overhang In Inches: <1 1/4\"> ")))
              (if (= nzl nil) (setq nzl 1.25)
              ) ;if
        ) ;progn else
    ) ;if dflts
) ;defun

;;;--------------------------------------------------------------------------
   
;-> draw steps

(defun str_draw ( / pt2      ;->points for polylines
                    pt3      ;->   "    "      "
                    pt4      ;->   "    "      "
                    pt5      ;->   "    "      "
                    lft      ;-> left for polar
                    rt       ;-> right      "
                    dn       ;-> dn         "
                    ang      ;-> angle      "
                    dist     ;-> distance   "
                    nostp    ;-> counter for while loop
                    step)    ;-> entity to copy

    (if (not tdir)   
       (progn                                    ;then
          (setq rt 0.0)             
          (setq lft pi)               
       ) ;progn                       
       (progn                                    ;else
          (setq rt pi)               
          (setq lft 0.0)               
       ) ;progn                       
     ) ;if
    (setq dn (* pi 1.5))
    (if strshp (setq nzl (- nzl (* nzh 0.5))) ;->subtract radius   
     ) ;if                                    ;  from nosing
    (setvar "osmode" 0)                       ;-> set osnap to none
    (setq pt2 (polar pt1 rt nzl))
    (setq pt3 (polar pt2 dn nzh))
    (setq pt4 (polar pt3 lft nzl))
        (if (not strshp)
            (command "pline" pt1 pt2 pt3 pt4 "")
            (command "pline" pt1 pt2 "a" pt3 "l" pt4 "")
        ) ;if
    (setq pt1 (polar pt1 dn rht))   
    (setq pt2 (polar pt1 rt (+ tsiz nzl)))
    (setq pt3 (polar pt2 dn nzh))
    (setq pt4 (polar pt3 lft nzl))
    (setq pt5 (polar pt4 dn (- rht nzh)))
        (if (not strshp)
            (command "pline" pt1 pt2 pt3 pt4 pt5 "")
            (command "pline" pt1 pt2 "a" pt3 "l" pt4 pt5 "")
        ) ;if
    (setq ang (angle pt1 pt5))
    (setq dist (distance pt1 pt5))
    (setq nostp (- nor 2))       ;-> set counter for while loop
        (while (>= nostp 1)
            (setq step (entlast))
            (setq pt1 pt5)
            (setq pt5 (polar pt1 ang dist))
                (command "copy" step "" pt1 pt5)
            (setq nostp (1- nostp))
        ) ;while
) ;defun
   
;;;---------------------------------------------------------------------------;;;

;->display properties of stairs at command line and prompt if you
;->want to print that information on the drawing.

(defun str_display ( / prntxt)

    (initget "Yes No")
    (setq prntxt (getkword
       "\nPrint Stair Dimensions On Drawing? (Y or N) <Y>"))
        (if (or
            (= prntxt nil)
            (= prntxt "Yes")
            ) ;or
            (setq prntxt 1)
        ) ;if

        (if (= prntxt 1)
          (progn
            (if (= (cdr (assoc 40 (tblsearch "style"  ;if no fixed
               (getvar "textstyle")))) 0.0)           ;text height
              (command "text" txtpt "" ""                     ;then
                (strcat "Overall Height Is: " (rtos th 4 4)))
              (command "text" txtpt ""                        ;else
                (strcat "Overall Height Is: " (rtos th 4 4)))
            ) ;if
          (command "text" ""
            (strcat (itoa nor)" Risers @ "(rtos rht 5 5)"\""))                     
          (command "text" ""
            (strcat (itoa (- nor 1))" Treads @ "(rtos tsiz 5 4)"\""))
          (command "text" ""
            (strcat "Angle is: " (angtos (atan rht tsiz) 0 2)" Degrees"))
          ) ;progn
        ) ;if

    (princ (strcat
       "\nOverall Height Is: "(rtos th 4 4)))
    (princ (strcat
       "\n"(itoa nor) " Risers @ "(rtos rht 5 5)"\"   " ))
    (princ (strcat
       (itoa (- nor 1)) " Treads @ "(rtos tsiz 5 4)"\"   "))
    (princ (strcat
       "Angle is "(angtos (atan rht tsiz) 0 2) " Degrees"))

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> defines ACAD command "stairs"

(defun c:stairs ( / slun      ;-> trap lunits
                   slprec    ;-> trap lunits precision
                   sosm      ;-> trap osnap setting
                   splw      ;-> trap plinewidth
                   scmd      ;-> trap cmdecho
                   stxtsz    ;-> trap textsize
                   nor       ;-> number of risers
                   rht       ;-> riser height
                   tsiz      ;-> tread size
                   nostp     ;-> number of steps
                   strshp    ;-> stair shape (round or square nose)
                   th        ;-> total height
                   pt1       ;-> top step
                   txtpt     ;-> point for text on drawing
                   tdir      ;-> stair direction
                   dflts     ;-> defaults or customize flag
                   nzh       ;-> nosing height (tread thickness)
                   nzl)      ;-> nosing overhang length
                 
    (prompt "\nStairs.lsp by DETOUR (C) Copyright By Dan E. Thomas 1997")
    (str_setup)
    (str_info)
    (str_draw)
    (str_display)
    (str_normex)
    (princ)

) ;defun



[Reimer]

Heb je ook al eens voor "Customize" gekozen (i.p.v. Defaults)? Je kunt dan zelf de maten opgeven voor de op- en aantrede. Dit kan in iedere gewenste eenheid. Alleen de optioneel te plaatsen tekst met de gebruikte maten gaat altijd uit van inches.

Reimer

[roy_043]

Het is niet moeilijk om de inch-aanduidingen zelf om te zetten naar decimale aanduidingen:
In het programma staan deze typische stukjes code:
(rtos dvsr 4 4)
(rtos rht 5 5)
(rtos mintrd 5 4)
Enz.
In totaal komt (rtos ... ? ?) 13 keer voor.

Het eerste getal moet je steeds vervangen door: 2
Het tweede getal moet je vervangen door gewenste afronding, bijvoorbeeld: 1 (d.w.z  1 cijfer achter de decimale punt)
Dus:
(rtos dvsr 4 4)
Wordt dan:
(rtos dvsr 2 1)
Enz.

[ludo59]

(setvar "insunits" 4) in de routine en u zal zien dat units veranderd

[roy_043]

(setvar "insunits" 4) in de routine en u zal zien dat units veranderd

Nee dat klopt niet. INSUNITS heeft te maken met het inserten van blocks en xrefs en daarvan is hier geen sprake.

[WebRacer]

deze lisp werd ontworpen voor inches...
mits wat aanpassingswerk kan je deze lisp ombouwen.