home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / STAIR.LSP < prev    next >
Encoding:
Text File  |  1991-10-17  |  2.8 KB  |  88 lines
  1. (vmon)
  2.  
  3. (defun staerr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command "layer" "s" "0" "")
  8.    (setvar "cmdecho" 1)
  9.    (setq *error* oer)
  10.    (princ)
  11. )
  12.  
  13. (defun C:STAIR(/ x sp ang ang0 ang2 wi hg n sk rk ni p1 n0 n1 lw x1 x2 x3 x4 p0 sk2 sk10 p2 p3 p01 y1 y2 y3 r1 r2 r3 r4 r5 q1 q2 q3 q01 q0 r0 z1 z2 z3 z4 z5 pl oer)
  14. (setvar "cmdecho" 0)
  15. (setq oer *error* *error* staerr)
  16. (initget 1 "Left Right")
  17. (setq x (getkword "╤í╘±╫≤╙╥╖╜╧≥? (Left or Right) "))
  18. (if (/= "Left" x) (setq x "Right" ang 0 ang0 (- ang 1.57079) ang2 (+ ang 1.57079)) (setq ang pi ang0 (+ ang 1.57079) ang2 (- ang 1.57079)))
  19. (setq wi (getdist "\n├┐╠ñ▓╜┐φ╢╚:"))
  20. (setq hg (getdist "\n├┐╠ñ▓╜╕▀╢╚:"))
  21. (setq n (getint "\n┬Ñ╠▌╠ñ▓╜╩²─┐:"))
  22. (setq sk (getdist "\n┬Ñ╠▌╝Σ┐τ╢╚:") sk2 (/ sk 2) sk10 (/ sk 10))
  23. (setq rk (getdist "\n╨▌╧ó╞╜╠¿╜°╔ε:"))
  24. (setq ni (getint "\n┬Ñ▓π╩²─┐:"))
  25. (setq sp (getpoint "\n╞≡╩╝╡π:"))
  26. (command "layer" "m" "sstair" "")
  27. (setq p1 sp n0 0 lw (* 0.5 (getvar "userr1")))
  28. (repeat ni
  29. (setq x1 (polar p1 (+ ang pi) (* sk10 0.7)))
  30. (setq x2 (polar x1 ang0 (/ sk2 10)))
  31. (setq x3 (polar x1 ang0 sk10))
  32. (setq x4 (polar x3 ang (* sk10 0.7)))
  33. (setq p0 (polar p1 ang0 (/ sk2 10)))
  34. (setq pl nil pl (cons p1 pl))
  35. (repeat n
  36. (setq p2 (polar p1 ang2 hg) pl (cons p2 pl))
  37. (setq p3 (polar p2 ang wi) pl (cons p3 pl))
  38. (setq p1 p3)
  39. )
  40. (setq n1 1 pl (reverse pl))
  41. (command "pline" (nth 0 pl) "w" lw "")
  42. (repeat (1- (length pl))
  43.    (command (nth n1 pl))
  44.    (setq n1 (1+ n1))
  45. )
  46. (command)
  47. (setq p01 (polar p3 ang0 (/ sk2 10)))
  48. (setq y1 (polar p3 ang (* 0.7 sk10)))
  49. (setq y2 (polar y1 ang0 sk10))
  50. (setq y3 (polar y2 (+ ang pi) (* 0.7 sk10)))
  51. (setq r1 (polar p2 ang (+ wi (+ rk 240))))
  52. (setq r2 (polar r1 ang0 sk10))
  53. (setq r3 (polar r2 (+ ang pi) 240))
  54. (setq r4 (polar r3 ang2 (- sk10 (/ sk2 10))))
  55. (setq r5 (polar y1 ang0 (/ sk2 10)))
  56. (command "pline" x2 x3 x4 p0 p01 y3 y2 r5 r4 r3 r2 r1 p3 "")
  57. (setq q1 p3 pl nil pl (cons q1 pl))
  58. (repeat n
  59. (setq q2 (polar q1 ang2 hg) pl (cons q2 pl))
  60. (setq q3 (polar q2 (+ ang pi) wi) pl (cons q3 pl))
  61. (setq q1 q3)
  62. )
  63. (setq n1 1 pl (reverse pl))
  64. (command "pline" (nth 0 pl) "w" 0 "")
  65. (repeat (1- (length pl))
  66.    (if (= n1 (1- (length pl))) (if (= n0 (1- ni)) (command (nth n1 pl))) (command (nth n1 pl)))
  67.    (setq n1 (1+ n1))
  68. )
  69. (command)
  70. (setq q01 (polar q3 ang0 (/ sk2 10)))
  71. (setq r0 (polar p3 (+ ang pi) wi))
  72. (setq q0 (polar r0 ang0 (- (/ sk2 10) hg)))
  73. (command "pline" q0 q01 "")
  74. (setq p1 q3)
  75. (setq n0 (1+ n0))
  76. ) ;end repeat ni
  77. (setq z1 (polar q3 (+ ang pi) (* 0.7 sk10)))
  78. (setq z2 (polar z1 ang0 sk10))
  79. (setq z3 (polar z2 ang (* 0.7 sk10)))
  80. (setq z4 (polar z2 ang2 (/ sk2 10)))
  81. (setq z5 (polar z3 ang2 sk10))
  82. (command "pline" z4 "w" lw "" z2 z3 z5 "")
  83. (command "layer" "s" "0" "") 
  84. (setvar "cmdecho" 1)
  85. (setq *error* oer)
  86. (princ)
  87. )
  88.