Visual LISP Tips เคล็ดลับ คำสั่งเขียนเส้นขั้นบันได Staircase

คำสั่ง Staircase ใช้สำหรับเขียนเส้นขั้นบันได (2D) โดยให้กำหนดจุดเริ่มต้นและจุดสิ้นสุด ตามด้วยจำนวนลูกขั้นที่ต้องการ โดยเป็นไฟล์ .LSP ตามโค้ดดังนี้

;;; Staircase 2D
;;; Deveoped by S.Chatchawal, schatchawal@gmail.com

(defun IsEven (int)
(zerop (rem int 2))
)

(defun 1u (u / d)
(setq d (sqrt (apply '+ (mapcar '* u u))))
(mapcar '/ u (list d d d))
)

(defun PointUD (pt u D)
(mapcar '+ pt (mapcar '* u (list D D D)))
)


(defun staircasedraw
(pt xdir w h nos / p0 j coords ydir *acaddoc* *model-space*)
(vl-load-com)
(setq
j 0
coords (reverse (cdr (reverse (trans pt 1 0))))
p0 coords
ydir (getvar "ucsydir")
)
(repeat (* 2 nos)
(setq j (1+ j))
(cond
((IsEven j) (setq p0 (PointUD p0 xdir w)))
(T (setq p0 (PointUD p0 ydir h)))
)
(setq
coords
(append coords p0)

)
)
(setq *acaddoc* (vla-get-activedocument
(vlax-get-Acad-Object)
)
*model-space*
(vla-get-modelspace
*acaddoc*
)
)
(vla-startundomark *acaddoc*)
(vlax-invoke
*model-space*
'AddLightweightPolyline
coords
)
(vla-endundomark *acaddoc*)
)

(vl-load-com)
(defun c:staircase (/ p q delta fuzz x msg tmp
pq p0 q0 delta L 1pq cosine
sine w h xdir *error*
)
(defun *error* (msg)
(if (not
(member msg (list "Function cancelled" "quit / exit abort"))
)
(princ (strcat "STAIRCASE Error: " msg))
)
(princ)
)
(initget 1)
(setq p (getpoint "\nSpecify start point: "))
(initget 33)
(setq q (getpoint p "\nSpecify end point: "))

(setq delta (mapcar '- q p)
fuzz (expt 0.1 (getvar "luprec"))
)
(cond
((vl-some '(lambda (x) (equal x 0.0 fuzz))
(reverse (cdr (reverse delta)))
)
(princ
"\nCannot draw staircase for 2 Horizontal or Vertical points!!!"
)
(exit)
)
(T
(if (not #staircase_nos)
(setq #staircase_nos 10)
)
(foreach msg (list "\nNumber of risers (or treads): <" #staircase_nos "> ")
(princ msg)
)
(if (setq tmp (getint))
(setq #staircase_nos tmp)
)
(setq pq (list p q)
pq (vl-sort pq '(lambda (x y) (< (cadr x) (cadr y))))
p0 (car pq)
q0 (cadr pq)
delta (mapcar '- q0 p0)
L (distance p0 q0)
1pq (1u delta)
cosine (abs (apply '+ (mapcar '* 1pq (list 1.0 0.0 0.0))))
sine (sqrt (- 1 (* cosine cosine)))
w (/ (* L cosine) #staircase_nos)
h (/ (* L sine) #staircase_nos)
)
(if (minusp (car (mapcar '- q0 p0)))
(setq xdir (mapcar '* (list -1.0 -1.0 -1.0) (getvar "ucsxdir")))
(setq xdir (getvar "ucsxdir"))
)
(staircasedraw p0 xdir w h #staircase_nos)
)
)
(princ)
)