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

0 Members and 1 Guest are viewing this topic.

pryzmm

  • Guest
Needed a Push on Stair Lisp Routine
« on: April 20, 2008, 10:18:16 AM »
hi everyone  :| ,

could anyone help me fill in some of the missing strings needed to somehow complete my idea of this lisp.
i have been assigned to edit thousand of "stair section" mainly using "stretch" and "offset" command for most of the editing.

as i can only understand very basic lisp i would appreciate if this will be done the old passion way,,,  :lol:
i attached herewith the sample stair drawing which roughly shows the things i needed to accomplished, below is the idea i had in mind;

Code: [Select]
;CODING STARTS HERE by; pryzmm '08
;
(prompt "\nuse ----->> command:test1 << ")
;
(defun c:test1 ()
(setq entity1 ("\nselect object to stretch & make the object layer current")
(setq p1 ("\nselect 1st point")
(setq p2 ("\nselect 2nd point")
(setq p3 ("\nselect 3rd point")
(setq p4 ("\nselect 4thd point")
;
(setvar "osmode" 0)
;
;direction variables
;
(setq d0
(strcase (getstring "\noffset direction (Right/Top/Left/Bottom): ")))
(cond
;if user pick to the right of object
((= d0 "R") ;[color=red]dont know how to go on[/color]
;if user pick on top of object
((= d0 "T") ;[color=red]dont know how to go on[/color]
;if user pick to the left of object
((= d0 "L") ;[color=red]dont know how to go on[/color]
;if user pick to the bottom of object
((= d0 "B") ;[color=red]dont know how to go on[/color]
)(princ)
;
;begin stretch command
(command "stretch" "cp" p1 p2 p3 p4 "" "" p1 "25" "")
;begin offset command
(command "offset" "50" entity1 d0 "")
;
;change osnap
(setvar "osmode" 33)
;begin while condition
(while (setq pt1 (getpoint "\n1st point"))
(setq pt2 (getpoint "\n2nd point"))
;begin line command
(command ".line" pt1 pt2 "")
(setq ent2 (entlast))
;begin offset command
(command ".offset" "150" ent2 d0 "")
;begin erase command
(command ".erase" ent2 "")
;
);end while
(princ)
);end

if my idea needed an overhaul by all mean pls. do so,,,
appreciate any help,,,  :-) thank you
« Last Edit: April 22, 2008, 11:10:25 AM by CAB »

ronjonp

  • Needs a day job
  • Posts: 7531
Re: Needed a Push on Lisp Routine
« Reply #1 on: April 20, 2008, 12:01:13 PM »
Maybe you could just make a block of the stairs you need, delete the old stairs, insert the block and explode?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: Needed a Push on Lisp Routine
« Reply #2 on: April 20, 2008, 07:12:20 PM »
if the stairs had to be a certain size factor, you could just draw everything at a 1:1, then figure out a scaling factor, say based on 2 picked points b/w an area on your plan set.
that picked factor set could then determine the scale needed for your created stair block and just insert you block and (entlast) explode the block. you could even easily combine into the routine to give you a chance to erase old stairs, etc. if needed.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

pryzmm

  • Guest
Re: Needed a Push on Lisp Routine
« Reply #3 on: April 20, 2008, 07:59:16 PM »
Maybe you could just make a block of the stairs you need, delete the old stairs, insert the block and explode?
ron -thanks i can't as the stairs has different risers requirements for every floor.

alan, if the stairs had to be a certain size factor,,,,,,,

alan-the stairs is already pre-define and as i mentioned every floor requires different risers as each stair is not all the same floor to floor height.
i have done a simple one but this requires 4 lisp (right "0 degrees"/ top "90"/ left "180" / bottom "270") see below, if i could somehow combine this into one routine and somehow the lisp evaluates the position in which user has to pick for the offset direction (right/top/left/bottom) and uses the appropriate offset presets (50mm and 150mm) as shown in my sample1.dwg
mind you after i run this lisp it worked but somehow theres a bug i could not fix,,(still a newbie of course)   :oops:

Code: [Select]
;by: pryzmm
;stretch p-line using crossing poly selection with offset.
;------------------------------------------------------------------
;
(prompt "\nuse ----->> command:ss0 << ")
;
(defun c:ss0 ();(/ ENT1 P1 P2 P3 P4 PT1 PT2 PT3)
;
;;;get old system variable
;
(setq oldlayer (getvar "clayer"))
(setq oldos (getvar "osmode"))
(setq oldortho (getvar "orthomode"))
(setq p5 "@25<0")
;
;;;change system variable
;
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
;
;;;code begin here
;
(setq ent1 (entsel "\nSelect Object to STRETCH"))
(setq p1 (getpoint "\n1st corner"))
(setq p2 (getpoint "\n2nd corner"))
(setq p3 (getpoint "\n3rd corner"))
(setq p4 (getpoint "\n4th corner"))
(command "stretch" "cp" p1 p2 p3 p4 "" "" p1 p5)
;(command "stretch" "cp" p1 p2 p3 p4 "" "" p1 "@25<0")
;
(setq pt3 (getpoint "\nBegin Offset command: Side to Offset"))
(command "offset" "50" ent1 pt3 "")
;
(setvar "osmode" 33)
;
(while (setq pt1 (getpoint "\n1st point"))
(setq pt2 (getpoint "\n2nd point"))
;
(command ".line" pt1 pt2 "")
(setq ent2 (entlast))
(command ".offset" "150" ent2 pt3 "")
(command ".erase" ent2 "")
;
;;;restore old variables
;
(setvar "clayer" oldlayer)
(setvar "osmode" oldos)
(setvar "cmdecho" cmdecho)
);end while
(princ)
);end
;;;----------------------------------------------------------------

pryzmm

  • Guest
Re: Needed a Push on Lisp Routine
« Reply #4 on: April 20, 2008, 08:01:33 PM »
oops forgot to mentioned, the lisp above is only for "0" degree if the user pick to the right of the selected entity,,,i have 3 more of this with different command: call of course,,,,,very troublesome huh,,,,tell me about it,,, :)

Dinosaur

  • Guest
Re: Needed a Push on Lisp Routine
« Reply #5 on: April 20, 2008, 08:46:42 PM »
Unlikely as it sounds, in a past existence between brief electrical and structural incarnations, I did this (by hand) for a prefab stair company.  I literally maxed out my HP15C just doing the calculations needed to define a stair riser (granted, the need to convert everything to inches and fractions bloated that some).  As I recall, the top and bottom risers could be different from the rest, but had to fall within a maximum and minimum value defined by the governing building code.  Also, the landings themselves were variables to be considered.  I am wondering if this may be asking a bit much from lisp given the variables.

Adesu

  • Guest
Re: Needed a Push on Lisp Routine
« Reply #6 on: April 20, 2008, 09:38:55 PM »
Hi pryzmm,
Test this code maybe can help you
Code: [Select]
(defun c:test (/ dis dpx ipx opt p1 p2 pt1 pt2 pt3 pt4)
  (setq pt1 '(0 0 0))
  (setq pt2 '(10 0 0))
  (setq pt3 '(10 5 0))
  (setq pt4 '(0 5 0))
  (command "_pline" pt1 pt2 pt3 pt4 "c" "")
  (initget "R T L B")
  (setq opt (strcase (getkword "\noffset direction (Right/Top/Left/Bottom): ")))
  (setq dis (getdist "\nEnter distance for stretch<10>: "))
  (if (= dis nil)(setq dis 10))
  (cond
    ((= opt "R")
     (setq p1 '(12 -2))
     (setq p2 '(8 7))
     (setq ipx pt2)
     (setq dpx (polar pt2 0 dis)))
    ((= opt "T")
     (setq p1 '(12 4))
     (setq p2 '(-2 7))
     (setq ipx pt3)
     (setq dpx (polar pt3 (* pi 0.5) dis)))
    ((= opt "L")
     (setq p1 '(2 -2))
     (setq p2 '(-2 7))
     (setq ipx pt4)
     (setq dpx (polar pt4 pi dis)))
    ((= opt "B")
     (setq p1 '(12 -2))
     (setq p2 '(-2 2))
     (setq ipx pt1)
     (setq dpx (polar pt1 (* pi 1.5) dis)))
    ) ; cond
  (command "_stretch" "c" p1 p2 "" ipx dpx "")
  (princ)
  )

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Needed a Push on Lisp Routine
« Reply #7 on: April 20, 2008, 11:33:19 PM »
Stairs must adhere to a set of rules. So you must define the rules for the lisp to
work within. This is often the hardest part of the process.

Here is a simple lisp. Just pick the top point of the steps & then the bottom point
of the flight of steps & it will draw a pline.
Do it again to get the second flight of steps.
Note that this is a demonstration and not meant to solve your request exactly.


Code: [Select]
(defun c:stair1 (/ ELV P1 P2 PT PTS RISE RISER RISERCNT RUN TOE TREAD TREADCNT ZDIR)
  (setq p1 (getpoint "\nPick Top of stair."))
  (setq p2 (getpoint "\nPick Bottom of stair."))
  (setq run      (- (car p2) (car p1))
        rise     (- (cadr p1) (cadr p2))
        treadCnt (abs (fix (/ run 300.0)))
        tread    (/ run treadCnt)
        RiserCnt (1+ treadCnt)
        Riser    (/ rise RiserCnt)
  )
  (if (minusp tread)
    (setq toe 25.0)
    (setq toe -25.0)
  )
  (setq pt  p1
        Pts (list pt)
  )
  (repeat TreadCnt
    (setq pt  (polar (polar pt (* pi 1.5) Riser) 0.0 toe)
          Pts (cons pt Pts)
          pt  (polar pt 0.0 (- tread toe))
          Pts (cons pt Pts)
    )
  )
  (setq pt  (polar (polar pt (* pi 1.5) Riser) 0.0 toe)
        Pts (cons pt Pts)
        pt (polar pt pi toe)
        Pts (cons pt Pts)
        )

  (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)
    )
  )
  (princ)
)
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 Lisp Routine
« Reply #8 on: April 21, 2008, 01:01:24 AM »
Test this code maybe can help you,,,
hi, adesu,, i did test your code but it crashes after the user input on the offset distance,,,  :oops:

Stairs must adhere to a set of rules. So you must define the rules for the lisp to
work within. This is often the hardest part of the process.

Here is a simple lisp. Just pick the top point of the steps & then the bottom point
of the flight of steps & it will draw a pline.
Do it again to get the second flight of steps.
Note that this is a demonstration and not meant to solve your request exactly.

cab, this is exactly what i needed, if somehow there could be an option for the user to input the "tread" size in my case its 300mm (nosing to nosing) and another one for the nos. of riser say "22" i could then pick the 2 points for the lisp to draw it


here's the step in which we determined the nos. of steps that goes in every storey.

1. say i have a floor to floor height of 3.2meters
2. divide this with the minimum (150mm) to maximum (180mm)  riser ht. in this case the best value will be 160mm as this will give me a whole nos. figure, (most of the time this is not the case) but the min. and max is our guide.
3. from here we would determine the nos. of steps, in this case its 10 steps each flight. total = 20 steps.

perhaps, the calculation process of determining the nos. of steps could be supply by the user instead of letting the lisp do it which may be difficult to construct.

something like this.

command: teststair

("\n Provide TREAD width")  -->> 300mm
("\n Nos. of RISER required) -->> say 20 
("\n pick 1st point)            -->> Floor landing (starting point)
("\n pick 2nd point)           -->> Landing

; then from here your lisp will run,,,,, is this possible ???  :|

thanks you so much guys

Adesu

  • Guest
Re: Needed a Push on Lisp Routine
« Reply #9 on: April 21, 2008, 01:25:07 AM »
Hi pryzmm,
That code not yet finnish until to stretch function, that only as sample.

Quote
hi, adesu,, i did test your code but it crashes after the user input on the offset distance,,,  :oops:


Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Needed a Push on Lisp Routine
« Reply #10 on: April 21, 2008, 08:23:33 AM »
cab, this is exactly what i needed, if somehow there could be an option for the user to input the "tread" size in my case its 300mm (nosing to nosing) and another one for the nos. of riser say "22" i could then pick the 2 points for the lisp to draw it

If your distance from floor to floor is fixed, and the riser height is fixed (150mm < 180mm), then the user will not need to enter the number of risers as it can be calculated from the 2 points picked by dividing the maximum riser and rounding up. Then the riser height would be recalculated based on the number of risers calculated.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Needed a Push on Lisp Routine
« Reply #11 on: April 21, 2008, 07:32:45 PM »
Here is a revised version.
Code: [Select]
;;  CAB 04.20.08
(defun c:stair2 (/ CNT DIR DN LANDING LANDLEN MAXRISERS MINRISERS
                 P1 P2 P3 PT PTS RISE RISER RISERCNT TOE TREAD ZDIR)

  (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)
      )
    )
  )
  (setq toe 25.0)
  (setq LandLen 1105.0)
  (or *tread* (setq *tread* 300))

  (setq p1 (getpoint "\nPick Top of stair."))
  (setq p2 (getpoint "\nPick Bottom of stair."))
  (setq p3 (getpoint "\nPick Side for stair."))
  (initget 6)
  (if
    (setq tread (getint (strcat "\nEnter Tread width: <" (itoa *tread*) ">")))
     (setq *tread* tread)
     (setq tread *tread*)
  )
  (setq rise      (- (cadr p1) (cadr p2))
        MaxRisers (fix (/ rise 160.0))
        MinRisers (fix (+ (/ rise 180.0) 0.99))
  )

  (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 landing (getint "\nEnter the riser # for the landing. "))
        (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)
)
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 Lisp Routine
« Reply #12 on: April 22, 2008, 08:33:14 AM »


cab--->>> your a genius  8-),,, your the mannn,,,thanks dude and to all who commented,,,  :mrgreen:



Andrea

  • Water Moccasin
  • Posts: 2372
Re: Needed a Push on Lisp Routine
« Reply #13 on: April 22, 2008, 10:38:21 AM »
Code: [Select]
(defun c:stairs (/ p2 p2e p2_Y p2_YD dist_Y
dist_YD dist_X dist_XD disT_T dist_D p1f
p1 nm p1a p1b
)
  (setq nm (fix (getreal "Number of step: ")))
  (setq p1 (getpoint "Point 1"))
  (simul2)

)




(defun simul2 ()

  (while (= (car (setq grr (grread T 4))) 5)
    (setq p2 (car (cdr grr)))
    (setq p2e p2)
    (setq p2_Y (- (nth 1 p1) (nth 1 p2)))
    (setq p2_YD (/ p2_Y (1+ nm)))
    (setq
      p2 (polar
   p2
   (angle (list 0.0 (nth 1 p2) 0.0) (list 0.0 (nth 1 p1) 0.0))
   p2_YD
)
    )
    (redraw)
    (setq dist_Y (- (nth 1 p1) (nth 1 p2)))
    (setq dist_YD (abs (/ dist_Y nm)))
    (setq dist_X (- (nth 0 p1) (nth 0 p2)))
    (setq dist_XD (abs (/ dist_X nm)))
    (setq disT_T (- (distance p1 p2) 0.5))
    (setq disT_D (abs (/ disT_T nm)))
    (setq p1f p1)
    (repeat nm
      (setq p1a (polar p1f
       (angle (list 0.0 (nth 1 p1f) 0.0)
      (list 0.0 (nth 1 p2) 0.0)
       )
       dist_YD
)
      )
      (setq p1b (polar p1f (angle p1f p2) disT_D))
      (grdraw p1f p1a 141 1)
      (grdraw p1a p1b 141 1)
      (setq p1f p1b)
    )
  )

  (setq p1f p1)
  (repeat nm
    (setq p1a
   (polar
     p1f
     (angle (list 0.0 (nth 1 p1f) 0.0) (list 0.0 (nth 1 p2) 0.0))
     dist_YD
   )
    )
    (setq p1b (polar p1f (angle p1f p2) disT_D))
    (vl-cmdf "._Pline" p1f p1a p1b "")
    (setq p1f p1b)
  )
  (redraw)
  (vl-cmdf "._Pline" p1b p2e "")
)



Keep smile...

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Needed a Push on Stair Lisp Routine
« Reply #14 on: April 22, 2008, 11:10:56 AM »
pryzmm you're welcome.
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.