;下面是c:ladder.lsp程序文件
;------------------------------------------------------------------
; This function enable you to draw the outline of the staircase
;------------------------------------------------------------------
;------------------------------------------------------------------
; This function will hatch the area of the staircase with brick
;------------------------------------------------------------------
;------------------------------------------------------------------
; The defination of the initial image of the staircase
;------------------------------------------------------------------
;------------------------------------------------------------------
; The initailization of the parent dialogbox
;------------------------------------------------------------------
(defun dlg1 ()
(initimg "ladder1" "ladder1")
(set_tile "L" (rtos L 2 2))
(set_tile "H" (rtos H 2 2))
(set_tile "N" (rtos N 2 2))
(action_tile "base" "(getdata1)(dlg2)")
(action_tile "accept" "(getdata1)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
)
;------------------------------------------------------------------
; This initialization of the child dialogbox
;------------------------------------------------------------------
(defun dlg2 ()
(if (not (new_dialog "base_pt" id))
(exit)
) ;
(initimg "ladder2" "ladder2")
(set_tile "x" (rtos x 2 2))
(set_tile "y" (rtos y 2 2))
(action_tile "pick" "(done_dialog 2)")
(action_tile "accept" "(getdata2)(done_dialog 3)")
(action_tile "cancel" "(done_dialog 4)")
(setq what (start_dialog))
(if (= what 2)
(done_dialog 2)
)
)
;------------------------------------------------------------------
; Get Datas from the parent dialogbox
;------------------------------------------------------------------
(defun getdata1 ()
(setq L (atof (get_tile "L")))
(setq H (atof (get_tile "H")))
(setq N (atof (get_tile "N")))
)
;------------------------------------------------------------------
; Get data from the child dialogbox
;------------------------------------------------------------------
(defun getdata2 ()
(setq x (atof (get_tile "x")))
(setq y (atof (get_tile "y")))
)
;------------------------------------------------------------------
; The main function
;------------------------------------------------------------------
(defun c:ladder (/ pt_base L H N what id x y pt_corner pt_top)
(setvar "cmdecho" 0)
(setq id (load_dialog "ladder"))
(setq what 3
L 1500
H 1000
N 20
x 80
y 50
)
(while (> what 1)
(if (not (new_dialog "ladder" id))
(exit)
)
(dlg1)
(if (= what 2)
(dlg2)
)
(if (/= what 2)
(setq what (start_dialog))
)
(if (= what 2)
(progn
(initget 1)
(setq pt_base (getpoint "\n楼梯左下角点位置:"))
(setq x (car pt_base)
y (cadr pt_base)
)
)
)
)
(setq pt_base (list x y))
(if(= what 1)
(progn
(setq pt_corner (POLAR pt_base 0.0 L))
(setq pt_top (POLAR pt_corner (/ pi 2.0) H))
(calculate_draw pt_base L H N)