Author Topic: Needed a Push on Stair Lisp Routine  (Read 7884 times)

0 Members and 1 Guest are viewing this topic.

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Needed a Push on Stair Lisp Routine
« Reply #15 on: April 22, 2008, 11:27:13 AM »
Here is my contribution.  A bit more than you needed but maybe it will spark some ideas.
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

pryzmm

  • Guest
Re: Needed a Push on Lisp Routine
« Reply #16 on: April 23, 2008, 12:16:39 AM »
Code: [Select]
[quote author=CAB link=topic=22642.msg272782#msg272782 date=1208820765]
  (setq rise      (- (cadr p1) (cadr p2))
        MaxRisers (fix (/ rise 160.0))
        MinRisers (fix (+ (/ rise 180.0) 0.99))
 
[/quote]

cab, been using your routine since the day you've ace it,,, somehow i run into some "bug" and needed your help again,,, here's what i did, since my requirements for the minimum riser is 172.0 mm and maximum riser is 177.0 i did the changes in your code as follow;

MaxRisers (fix (/ rise 160.0))
        MinRisers (fix (+ (/ rise 180.0) 0.99))

pryzmm

  • Guest
Re: Needed a Push on Stair Lisp Routine
« Reply #17 on: April 23, 2008, 12:24:15 AM »
oops,, fat fingers press enter accidently,,, anyway to continue, i change the figure shown in your routine to such;

        MaxRisers (fix (/ rise 172.0))
        MinRisers (fix (+ (/ rise 179.0) 0.99))

the floor to floor height i was working on is 4300mm (4.3 meters) if i do the math it will give me 25 riser with 172mm

going back to the changes i made above, i save and run the lisp again, it give me the

"Out of range, try again" warning even though i press the given data shown in the prompt (25 to 24).

perhaps when you have time, you could take a look and see if theres a work around it.

note; if i change the "MaxRisers (fix (/ rise 172.0))" to 170.0 instead of 172.0 it work,,, but somehow i need to know why it did'nt work if i put in 172.0???

thank you

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Needed a Push on Stair Lisp Routine
« Reply #18 on: April 23, 2008, 08:43:39 AM »
It's one of those weird ACAD rounding errors.
Try this:
Code: [Select]
  (setq rise      (+ (- (cadr p1) (cadr p2)) 1e-6)
        MaxRisers (fix (/ rise 172.0))
        MinRisers (fix (+ (/ rise 179.0) 0.99))
  )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

pryzmm

  • Guest
Re: Needed a Push on Stair Lisp Routine
« Reply #19 on: April 23, 2008, 10:49:58 AM »
TimSpangler-->> many thanks for your contri,,,



It's one of those weird ACAD rounding errors.
Try this:
Code: [Select]
  (setq rise      (+ (- (cadr p1) (cadr p2)) 1e-6)
        MaxRisers (fix (/ rise 172.0))
        MinRisers (fix (+ (/ rise 179.0) 0.99))
  )

cab,, done what you've recommended, somehow that did not do the trick,,,  :laugh: hmmmm, many thanks again,,, i still gonna use this on a daily basis,,, great program  8-)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Needed a Push on Stair Lisp Routine
« Reply #20 on: April 23, 2008, 11:00:22 AM »
Try this and if it doesn't work upload a sample DWG with the landings clearly marked for me to test.
Code: [Select]
;;  CAB 04.23.08
(defun c:stair2 (/ CNT DIR DN LANDING LANDLEN MAXRISERS MINRISERS P1 P2 P3 PT
                 PTS RISE RISER RISERCNT TOE TREAD ZDIR MaxRise MinRise MakePoly
                )

  (setq MaxRise 178
        MinRise 172
        toe 25.0
  )
  (setq LandLen 1105.0)
  (or *tread* (setq *tread* 300))


  (defun MakePoly (pts layer / zdir elv)
    (setq zdir (trans '(0 0 1) 1 0 t)
          elv  (caddr (trans (car pts) 1 zdir))
    )
    (entmakex
      (append
        (list '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(100 . "AcDbPolyline")
              (cons 8 layer)
              (cons 90 (length pts))
              (cons 70 0) ; 1 for closed 0 overwise
              (cons 38 elv)
              (cons 210 zdir)
        )
        (mapcar '(lambda (pt) (cons 10 (trans pt 1 zdir))) pts)
      )
    )
  )

  (if (and
        (setq p1 (getpoint "\nPick Top of stair."))
        (setq p2 (getpoint "\nPick Bottom of stair."))
        (setq p3 (getpoint "\nPick Side for stair."))
      )
    (progn
      (initget 6)
      (if
        (setq
          tread (getint (strcat "\nEnter Tread width: <" (itoa *tread*) ">"))
        )
         (setq *tread* tread)
         (setq tread *tread*)
      )
      ;;  adjust rise as ACAD rounding error prevents (/ 4300.0 172.0) 25
      (setq rise      (+ (- (cadr p1) (cadr p2)) 1e-6)
            MaxRisers (fix (/ rise (float MinRise)))
            MinRisers (fix (+ (/ rise (float MaxRise)) 0.99))
      )

      (if (= MinRisers MaxRisers)
        (setq riserCnt MinRisers)
        (while
          (progn
            (initget 6)
            (setq riserCnt (getint (strcat "\nEnter number of risers ["
                                           (itoa MinRisers) " to "
                                           (itoa MaxRisers) "] "
                                   )
                           )
            )
            (if (<= MinRisers RiserCnt MaxRisers)
              nil ; exit loop
              (princ "\nOut of range, try again.")
            )
          )
        )
      )

      (setq riser (/ rise RiserCnt))

      (if (zerop (rem RiserCnt 2)) ; even number
        (setq landing (/ RiserCnt 2)) ;
        (while
          (progn
            ;;  riser number from the bottom
            (setq tmp (fix (/ MaxRisers 2.)))
            (initget 6)
            (setq landing (getint (strcat "\nEnter the riser # for the landing. <"
                                          (itoa tmp) "> ")))
            (or landing (setq landing tmp))
            (if (< 1 landing MaxRisers)
              nil
              (princ "\nOut of range, try again.")
            )
          )
        )
      )


      (if (> (car p1) (car p3)) ; stair left
        (setq dir pi)
        (setq dir 0.0)
      )

      ;;  Start Stair at top
      (setq pt  p1
            Pts (list pt)
            dn  (* pi 1.5) ; down direction
            cnt RiserCnt
      )
      (repeat (1- RiserCnt)
        (if (= landing (setq cnt (1- cnt)))
          (progn
            (setq pt  (polar (polar pt dn Riser) (+ dir pi) toe)
                  Pts (cons pt Pts)
                  pt  (polar pt dir toe)
                  Pts (cons (polar pt dir LandLen) Pts)
            )
            (makePoly pts (getvar "clayer"))
            (setq pts (list pt))
            (if (zerop dir)
              (setq dir pi)
              (setq dir 0.0)
            )
          )
          (setq pt  (polar (polar pt dn Riser) (+ dir pi) toe) ; riser
                Pts (cons pt Pts)
                pt  (polar pt dir (+ tread toe)) ; tread
                Pts (cons pt Pts)
          )

        )
      )
      ;;  add last riser
      (setq pt  (polar (polar pt dn Riser) (+ dir pi) toe)
            Pts (cons pt Pts)
            pt  (polar pt dir toe)
            Pts (cons pt Pts)
      )
      (makePoly pts (getvar "clayer"))
    )
  )
  (princ)
)
(prompt "\nStair with Landing Loaded, Enter Stair2 to run.")
(princ)
« Last Edit: April 23, 2008, 11:13:22 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

pryzmm

  • Guest
Re: Needed a Push on Stair Lisp Routine
« Reply #21 on: April 25, 2008, 12:19:40 AM »
Try this and if it doesn't work upload a sample DWG with the landings clearly marked for me to test.
Code: [Select]
;;  CAB 04.23.08
(defun c:stair2 (/ CNT DIR DN LANDING LANDLEN MAXRISERS MINRISERS P1 P2 P3 PT
                 PTS RISE RISER RISERCNT TOE TREAD ZDIR MaxRise MinRise MakePoly
                )

  (setq MaxRise 178
        MinRise 172
        toe 25.0
  )
  (setq LandLen 1105.0)
  (or *tread* (setq *tread* 300))


  (defun MakePoly (pts layer / zdir elv)
    (setq zdir (trans '(0 0 1) 1 0 t)
          elv  (caddr (trans (car pts) 1 zdir))
    )
    (entmakex
      (append
        (list '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(100 . "AcDbPolyline")
              (cons 8 layer)
              (cons 90 (length pts))
              (cons 70 0) ; 1 for closed 0 overwise
              (cons 38 elv)
              (cons 210 zdir)
        )
        (mapcar '(lambda (pt) (cons 10 (trans pt 1 zdir))) pts)
      )
    )
  )

  (if (and
        (setq p1 (getpoint "\nPick Top of stair."))
        (setq p2 (getpoint "\nPick Bottom of stair."))
        (setq p3 (getpoint "\nPick Side for stair."))
      )
    (progn
      (initget 6)
      (if
        (setq
          tread (getint (strcat "\nEnter Tread width: <" (itoa *tread*) ">"))
        )
         (setq *tread* tread)
         (setq tread *tread*)
      )
      ;;  adjust rise as ACAD rounding error prevents (/ 4300.0 172.0) 25
      (setq rise      (+ (- (cadr p1) (cadr p2)) 1e-6)
            MaxRisers (fix (/ rise (float MinRise)))
            MinRisers (fix (+ (/ rise (float MaxRise)) 0.99))
      )

      (if (= MinRisers MaxRisers)
        (setq riserCnt MinRisers)
        (while
          (progn
            (initget 6)
            (setq riserCnt (getint (strcat "\nEnter number of risers ["
                                           (itoa MinRisers) " to "
                                           (itoa MaxRisers) "] "
                                   )
                           )
            )
            (if (<= MinRisers RiserCnt MaxRisers)
              nil ; exit loop
              (princ "\nOut of range, try again.")
            )
          )
        )
      )

      (setq riser (/ rise RiserCnt))

      (if (zerop (rem RiserCnt 2)) ; even number
        (setq landing (/ RiserCnt 2)) ;
        (while
          (progn
            ;;  riser number from the bottom
            (setq tmp (fix (/ MaxRisers 2.)))
            (initget 6)
            (setq landing (getint (strcat "\nEnter the riser # for the landing. <"
                                          (itoa tmp) "> ")))
            (or landing (setq landing tmp))
            (if (< 1 landing MaxRisers)
              nil
              (princ "\nOut of range, try again.")
            )
          )
        )
      )


      (if (> (car p1) (car p3)) ; stair left
        (setq dir pi)
        (setq dir 0.0)
      )

      ;;  Start Stair at top
      (setq pt  p1
            Pts (list pt)
            dn  (* pi 1.5) ; down direction
            cnt RiserCnt
      )
      (repeat (1- RiserCnt)
        (if (= landing (setq cnt (1- cnt)))
          (progn
            (setq pt  (polar (polar pt dn Riser) (+ dir pi) toe)
                  Pts (cons pt Pts)
                  pt  (polar pt dir toe)
                  Pts (cons (polar pt dir LandLen) Pts)
            )
            (makePoly pts (getvar "clayer"))
            (setq pts (list pt))
            (if (zerop dir)
              (setq dir pi)
              (setq dir 0.0)
            )
          )
          (setq pt  (polar (polar pt dn Riser) (+ dir pi) toe) ; riser
                Pts (cons pt Pts)
                pt  (polar pt dir (+ tread toe)) ; tread
                Pts (cons pt Pts)
          )

        )
      )
      ;;  add last riser
      (setq pt  (polar (polar pt dn Riser) (+ dir pi) toe)
            Pts (cons pt Pts)
            pt  (polar pt dir toe)
            Pts (cons pt Pts)
      )
      (makePoly pts (getvar "clayer"))
    )
  )
  (princ)
)
(prompt "\nStair with Landing Loaded, Enter Stair2 to run.")
(princ)


cabbbb,,,, youve ace it again mannn ,,, thanks,,,,

just thought i could still push your great program,,, is there a way for this to prompt the user for its minimum/ maximum riser height then store it as the default till user change it again in the command prompt, instead of "opening the lips and amending its parameters (min. max. riser ht.)"

Code: [Select]
(setq [color=red]MaxRise 178[/color]
        [color=red]MinRise 172[/color]
        toe 25.0
  )

,,, this would be superbbb for me, if youve have time that is,,, right now your program has been gaining popularity in my office,, thanks to you,,,

muchas gracias amigo (hope u dont mind me calling you amigo's)  :mrgreen:

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Needed a Push on Stair Lisp Routine
« Reply #22 on: April 25, 2008, 09:07:59 AM »
Here is an example for you to use as user input of an interger.

Code: [Select]
;;  MaxRise is global var so do not declare it.
;;  remove MaxRise from the list right after the defun
(or MaxRise (setq MaxRise 178)) ; set the default for the first time through
(cond
  ((setq temp (getint (strcat "\nEnter Max Riser Range: <" (itoa MaxRise) ">")))
   (setq MaxRise temp))
)

If it is a real number I use this method. Can you see the three changes I made?

Code: [Select]
;;  MaxRise is global var so do not declare it.
;;  remove MaxRise from the list right after the defun
(or MaxRise (setq MaxRise 178.0)) ; set the default for the first time through
(cond
  ((setq temp (getdist (strcat "\nEnter Max Riser Range: <" (rtos MaxRise 2 2) ">")))
   (setq MaxRise temp))
)

Be sure and change this:
Code: [Select]
(setq MaxRise 178
        MinRise 172
        toe 25.0
  )
To this:
Code: [Select]
(setq toe 25.0)
And remove MaxRise from here so it isn't declaired:
Code: [Select]
(defun c:stair2 (/ CNT DIR DN LANDING LANDLEN MAXRISERS MINRISERS P1 P2 P3 PT
                 PTS RISE RISER RISERCNT TOE TREAD ZDIR [color=red]MaxRise[/color] MinRise MakePoly
                )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

pryzmm

  • Guest
Re: Needed a Push on Stair Lisp Routine
« Reply #23 on: April 26, 2008, 01:00:16 AM »
cab,,, awsome,,,thanks