如何用lisp画出这样的楼梯呢？已解决【感谢zhynt大侠相助】

qcw911 · 发表于 2011-7-29 23:38:09

回复 zhynt 的帖子

调试完了
还差随层没整了
以及一些细节
zhynt大侠先不麻烦你了
等我遇到整不了的困难
再请你出山吧
我先自己处理
再次感谢zhynt
qiuw1处是我改得呵呵

;;;;
(defun err (s)
(if (and (/= s "console break")
(/= s "Function cancelled")
(/= s "quit/exit abort")
)
(progn (setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(setq *error* olderr)
(command "UNDO" "E")
(princ (strcat "\n程序出错或用户退出:" s))
)
)
)
;;;生成线段并放入选集
(defun make_line (lay pts pte)
(entmake (list '(0 . "LINE")
(cons 8 lay)
(cons 10 pts)
(cons 11 pte)
)
)
(setq en (entlast))
(setq ss (ssadd en ss))
)
(defun make_line2 (lay pt ang)
(setq pts (polar pt (+ s_ang ang) (/ gap 2))
pte (polar pts (+ s_ang ang) dist)
)
(make_line lay pts pte)
(setq en (entlast))
(setq ss (ssadd en ss))
)
(defun make_line3 (lay pt ang) ;QIUW1
(setq pts (polar pt (+ s_ang ang) (/ (/ gap 2) (cos (dtor 30)) ))
;;; pts (polar pt (+ s_ang ang) (/ gap 2))
pte (polar pts (+ s_ang ang) dist)
)
(make_line lay pts pte)
(setq en (entlast))
(setq ss (ssadd en ss))
)
(defun make_arc (lay cen Radius angs ange)
(entmake (list '(0 . "ARC")
(cons 8 lay)
(cons 10 cen)
(cons 40 Radius)
(cons 50 angs)
(cons 51 ange)
)
)
(setq en (entlast))
(setq ss (ssadd en ss))
)
;;;定义角度转换函数，将角度转换为弧度
(defun dtor (ang) (/ (* ang PI) 180))
;;;;
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;;
(defun c:ltpm ()
(command "undo" "BE")
(setq oldos (getvar "osmode")
oldcmd (getvar "cmdecho")
oldlay (getvar "CLAYER")
olderr *error*
*error* err
)
(setvar "cmdecho" 0)
(if (= (TBLOBJNAME "LAYER" "Stair") nil)
(command "layer" "m" "Stair" "c" "4" "" "")
)
(setvar "clayer" oldlay)
(setq ss (ssadd))
(setq pta (getpoint "\n指定插入点:"))
(setq ptb (getpoint pta "\n:输入楼梯间宽度兼绘制角度:"))
(setq Stair_width (distance pta ptb))
(setq s_ang (angle pta ptb))
(setq pt (polar pta
(+ s_ang (dtor 315))
(* 0.5 Stair_width (sqrt 2))
)
)
(if (< oldos 16384)
(setvar "osmode" (+ oldos 16384))
)
(setq Bench_width (getreal "\n输入梯段宽度:<1200>"))
(if (= Bench_width nil)
(setq Bench_width 1200.0)
)
(while (> (- Bench_width (/ Stair_width 2.0)) 0)
(setq Bench_width (getreal "\n该梯段宽度不合适,重新输入:"))
)
(setq Stepping_width (getreal "\n输入踏步宽度:<280>"))
(if (= Stepping_width nil)
(setq Stepping_width 280.0)
)
(setq Bench_UP (getint "\n输入上梯段步数:<2>"))
(if (= Bench_UP nil)
(setq Bench_UP 2)
)
(setq Bench_DN (getint "\n输入下梯段步数:<4>"))
(if (= Bench_DN nil)
(setq Bench_DN 4)
)
(setq Gap (- Stair_width (* Bench_width 2))) ;梯段间隙
;(if (/= gap 0)
(progn (setq pt1 (polar pt s_ang (/ gap 2))
pt2 (polar pt (+ s_ang pi) (/ gap 2))
)
;;; (make_arc "Stair" pt (/ gap 2) s_ang (+ s_ang pi))
(setq pt11 (polar pt (+ s_ang(/ pi 4)) (* (sqrt 2) (/ gap 2)));;;;;;;;qiuw1
pt12 (polar pt (+ s_ang (* 3 (/ pi 4))) (* (sqrt 2) (/ gap 2)));;;;;;;;qiuw1
)
(make_line "Stair" pt11 pt12);qiuw1
(setq pt3 (polar pt1 (+ s_ang (* 1.5 pi)) (* Bench_DN Stepping_width))
pt4 (polar pt2 (+ s_ang (* 1.5 pi)) (* Bench_up Stepping_width))
)
;;; (make_line "Stair" pt1 pt3)
;;; (make_line "Stair" pt2 pt4)
(make_line "Stair" pt11 pt3);;;;;;;;qiuw1
(make_line "Stair" pt12 pt4);;;;;;;;qiuw1
(make_line "Stair" pt1 (polar pt1 s_ang Bench_width))
(make_line "Stair" pt2 (polar pt2 (+ s_ang pi) Bench_width))
(setq n 0)
(repeat Bench_DN
(setq pt5 (polar pt3 (+ s_ang (* 0.5 pi)) (* n Stepping_width))
pt6 (polar pt5 s_ang Bench_width)
)
(make_line "Stair" pt5 pt6)
(setq n (1+ n))
)
(setq n 0)
(repeat Bench_up
(setq pt5 (polar pt4 (+ s_ang (* 0.5 pi)) (* n Stepping_width))
pt6 (polar pt5 (+ s_ang pi) Bench_width)
)
(make_line "Stair" pt5 pt6)
(setq n (1+ n))
)
;;; (setq dist (- (/ (+ Bench_width (/ gap 2)) (cos (dtor 30))) (/ gap 2)))
(setq dist (/ Bench_width (cos (dtor 30)) ));;;;;;;;;;;;;QIUW1
(make_line3 "Stair" pt (dtor 30))
(make_line3 "Stair" pt (dtor 60))
(make_line3 "Stair" pt (dtor 120))
(make_line3 "Stair" pt (dtor 150))
(setq pt5 (polar pt (+ s_ang (dtor 90)) (/ gap 2))
pt6 (polar pt5 (+ s_ang (dtor 90)) Bench_width)
)
(make_line "Stair" pt5 pt6)
;;; (command "_.group" "" "*" "" ss "")
)
;)
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(command "UNDO" "E")
(princ)
)

;;;; 
(defun err (s) 
  (if (and (/= s "console break") 
           (/= s "Function cancelled") 
           (/= s "quit/exit abort") 
      ) 
    (progn (setvar "osmode" oldos) 
           (setvar "cmdecho" oldcmd) 
           (setq *error* olderr) 
           (command "UNDO" "E") 
           (princ (strcat "\n程序出错或用户退出:" s)) 
    ) 
  ) 
) 
;;;生成线段并放入选集 
(defun make_line (lay pts pte) 
  (entmake (list '(0 . "LINE") 
                 (cons 8 lay) 
                 (cons 10 pts) 
                 (cons 11 pte) 
           ) 
  ) 
  (setq en (entlast)) 
  (setq ss (ssadd en ss)) 
) 
(defun make_line2 (lay pt ang) 
  (setq        pts (polar pt (+ s_ang ang) (/ gap 2)) 
        pte (polar pts (+ s_ang ang) dist) 
  ) 
  (make_line lay pts pte) 
  (setq en (entlast)) 
  (setq ss (ssadd en ss)) 
) 
(defun make_line3 (lay pt ang)  ;QIUW1 
  (setq        pts (polar pt (+ s_ang ang) (/ (/ gap 2)  (cos (dtor 30)) )) 
;;;                pts (polar pt (+ s_ang ang) (/ gap 2)) 
        
        pte (polar pts (+ s_ang ang) dist) 
  ) 
  (make_line lay pts pte) 
  (setq en (entlast)) 
  (setq ss (ssadd en ss)) 
) 
(defun make_arc        (lay cen Radius angs ange) 
  (entmake (list '(0 . "ARC") 
                 (cons 8 lay) 
                 (cons 10 cen) 
                 (cons 40 Radius) 
                 (cons 50 angs) 
                 (cons 51 ange) 
           ) 
  ) 
  (setq en (entlast)) 
  (setq ss (ssadd en ss)) 
) 
;;;定义角度转换函数，将角度转换为弧度 
(defun dtor (ang) (/ (* ang PI) 180)) 
;;;; 
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
;;;; 
(defun c:ltpm () 
  (command "undo" "BE") 
  (setq oldos (getvar "osmode") 
          oldcmd        (getvar "cmdecho") 
        oldlay (getvar "CLAYER") 
        olderr        *error* 
        *error*        err 
  ) 
  (setvar "cmdecho" 0) 
  (if (= (TBLOBJNAME "LAYER" "Stair") nil) 
    (command "layer" "m" "Stair" "c" "4" "" "") 
  ) 
  (setvar "clayer" oldlay) 
  (setq ss (ssadd)) 
  (setq pta (getpoint "\n指定插入点:")) 
  (setq ptb (getpoint pta "\n:输入楼梯间宽度兼绘制角度:")) 
  (setq Stair_width (distance pta ptb)) 
  (setq s_ang (angle pta ptb)) 
  (setq        pt (polar pta 
                  (+ s_ang (dtor 315)) 
                  (* 0.5 Stair_width (sqrt 2)) 
           ) 
  ) 
  (if (< oldos 16384) 
    (setvar "osmode" (+ oldos 16384)) 
  ) 
  (setq Bench_width (getreal "\n输入梯段宽度:<1200>")) 
  (if (= Bench_width nil) 
    (setq Bench_width 1200.0) 
  ) 
  (while (> (- Bench_width (/ Stair_width 2.0)) 0) 
    (setq Bench_width (getreal "\n该梯段宽度不合适,重新输入:")) 
  ) 
  (setq Stepping_width (getreal "\n输入踏步宽度:<280>")) 
  (if (= Stepping_width nil) 
    (setq Stepping_width 280.0) 
  ) 
  (setq Bench_UP (getint "\n输入上梯段步数:<2>")) 
  (if (= Bench_UP nil) 
    (setq Bench_UP 2) 
  ) 
  (setq Bench_DN (getint "\n输入下梯段步数:<4>")) 
  (if (= Bench_DN nil) 
    (setq Bench_DN 4) 
  ) 
  (setq Gap (- Stair_width (* Bench_width 2)))                    ;梯段间隙 
  ;(if (/= gap 0) 
    (progn (setq pt1 (polar pt s_ang (/ gap 2)) 
                 pt2 (polar pt (+ s_ang pi) (/ gap 2)) 
           ) 
;;;           (make_arc "Stair" pt (/ gap 2) s_ang (+ s_ang pi)) 
             (setq pt11 (polar pt  (+ s_ang(/ pi 4)) (*  (sqrt 2) (/ gap 2)));;;;;;;;qiuw1 
                   pt12 (polar pt (+ s_ang  (* 3 (/ pi 4))) (*  (sqrt 2) (/ gap 2)));;;;;;;;qiuw1 
              ) 
       
           (make_line "Stair" pt11 pt12);qiuw1 
 
           (setq pt3 (polar pt1 (+ s_ang (* 1.5 pi)) (* Bench_DN Stepping_width)) 
                 pt4 (polar pt2 (+ s_ang (* 1.5 pi)) (* Bench_up Stepping_width)) 
           ) 
;;;           (make_line "Stair" pt1 pt3) 
;;;           (make_line "Stair" pt2 pt4) 
                 (make_line "Stair" pt11 pt3);;;;;;;;qiuw1 
           (make_line "Stair" pt12 pt4);;;;;;;;qiuw1 
           (make_line "Stair" pt1 (polar pt1 s_ang Bench_width)) 
           (make_line "Stair" pt2 (polar pt2 (+ s_ang pi) Bench_width)) 
           (setq n 0) 
           (repeat Bench_DN 
             (setq pt5 (polar pt3 (+ s_ang (* 0.5 pi)) (* n Stepping_width)) 
                   pt6 (polar pt5 s_ang Bench_width) 
             ) 
             (make_line "Stair" pt5 pt6) 
             (setq n (1+ n)) 
           ) 
           (setq n 0) 
           (repeat Bench_up 
             (setq pt5 (polar pt4 (+ s_ang (* 0.5 pi)) (* n Stepping_width)) 
                   pt6 (polar pt5 (+ s_ang pi) Bench_width) 
             ) 
             (make_line "Stair" pt5 pt6) 
             (setq n (1+ n)) 
           ) 
       
;;;           (setq dist (- (/ (+ Bench_width (/ gap 2)) (cos (dtor 30))) (/ gap 2))) 
       
           (setq dist (/ Bench_width  (cos (dtor 30)) ));;;;;;;;;;;;;QIUW1 
       
           (make_line3 "Stair" pt (dtor 30)) 
           (make_line3 "Stair" pt (dtor 60)) 
           (make_line3 "Stair" pt (dtor 120)) 
           (make_line3 "Stair" pt (dtor 150)) 
 
           (setq pt5 (polar pt (+ s_ang (dtor 90)) (/ gap 2)) 
                 pt6 (polar pt5 (+ s_ang (dtor 90)) Bench_width) 
           ) 
           (make_line "Stair" pt5 pt6) 
;;;           (command "_.group" "" "*" "" ss "") 
    ) 
  ;) 
  (setvar "osmode" oldos) 
  (setvar "cmdecho" oldcmd) 
  (command "UNDO" "E") 
  (princ) 
)

qcw911 · 发表于 2011-8-2 11:42:33

回复 zhynt 的帖子

再次感谢大侠!
在你的基础上
解决了我的问题
我是新人以后还请你多帮忙

qcw911 · 发表于 2011-8-5 13:52:32

本帖最后由 qcw911 于 2011-8-5 14:02 编辑

回复 zhynt 的帖子

大侠有问题了
但不知道问题在哪里
就是加了一个对话框
调整了好多次都不行
请帮忙解决

(defun c:tt()
(Form1_load)
)
(defun Form1_load( / dcl_id Dialog_Return key keys)
(vl-load-com)
(setq dcl_id (load_dialog "C:\\Documents and Settings\\qiuw1\\Desktop\\ltpm\\stair.DCL"))
(setq Dialog_Return 2)
(while (> Dialog_Return 1)
(new_dialog "stair" dcl_id)
(setq keys '("Stepping_w" "Stair_w" "Image1" "Bench_N""accept" "cancel"))
(start_image "Image1")
(fill_image 0 0 (dimx_tile "Image1") (dimy_tile "Image1") 0)
(slide_image 0 0 (dimx_tile "Image1") (dimy_tile "Image1") "C:\\Documents and Settings\\qiuw1\\Desktop\\ltpm\\stair.sld")
(end_image)
(foreach key keys
(if (eval (read (strcat key "_bak"))) (set_tile key (eval (read (strcat key "_bak")))))
(action_tile key "(Action_Form1_Keys $key $value)")
)
(setq Dialog_Return (start_dialog))
(cond
((= Dialog_Return 1)
(ltpm1)
)
((= Dialog_Return 3)
(getp)
)
)
)
(unload_dialog dcl_id)
(princ)
)
(defun Picture1 (x y)
(print "---")
(print (list x y))
(print "===")
)
(defun Action_Form1_Keys (key value)
(print (list key value))(print "*-------*")
(cond
((= key "accept")
(Get_Form1_Data)
(setq Stepping_width (atof(get_tile "Stepping_w" )))
(setq Bench_DN (atof(get_tile "Bench_N")))
(done_dialog 1)
)
((= key "cancel")
(done_dialog 0)
)
((= key "Image1")
(done_dialog 3)
)
((= key "Stair_w")
(done_dialog 3)
)
((= key "Check1")
()
)
)
)
(defun Get_Form1_Data( / key)
(foreach key keys
(set (read (strcat key "_bak")) (get_tile key))
)
)
(defun getp()
(setq pta (getpoint "\n插入点:"))
(setq ptb (getpoint pta "\n楼梯宽度以及角度:"))
)
(defun err (s)
(if (and (/= s "console break")
(/= s "Function cancelled")
(/= s "quit/exit abort")
)
(progn (setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(setq *error* olderr)
(command "UNDO" "E")
(princ (strcat "\n出错时退出:" s))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mid(ptt1 ptt2)
(setq p1x(car ptt1))
(setq p1y(cadr ptt1))
(setq p2x(car ptt2))
(setq p2y(cadr ptt2))
(setq px(/ (+ p1x p2x) 2))
(setq py(/ (+ p1y p2y) 2))
(setq mpt(list px py))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun make_line (pts pte)
(entmake (list '(0 . "LINE")
(cons 10 pts)
(cons 11 pte)
)
)
;;; (setq en (entlast))
;;; (setq ss (ssadd en ss))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun make_line3 (pt ang)
(setq pts pt
pte (polar pts (+ s_ang ang) (/ Stair_width (cos (dtor 30)) ))
)
(make_line pts pte)
;;; (setq en (entlast))
;;; (setq ss (ssadd en ss))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dtor (ang) (/ (* ang PI) 180))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ltpm1 (/ ss pta ptb Stair_width s_ang Bench_width Stepping_width Bench_DN pt pt1 pt2 pt3 pt6 pt13)
(command "undo" "BE")
(setq oldos (getvar "osmode")
oldcmd (getvar "cmdecho")
oldlay (getvar "CLAYER")
olderr *error*
*error* err
)
(setvar "cmdecho" 0)
(setvar "clayer" oldlay)
(setq ss (ssadd))
;;; (setq pta (getpoint "\n插入点:"))
;;; (setq ptb (getpoint pta "\n:楼梯宽度以及角度:"))
(setq Stair_width (distance pta ptb))
(setq s_ang (angle pta ptb))
(setq pt (polar pta
(+ s_ang (dtor 315))
(* Stair_width (sqrt 2))
)
)
(if (< oldos 16384)
(setvar "osmode" (+ oldos 16384))
)
(setq Bench_width Stair_width)
;;; (while (> (- Bench_width Stair_width ) 0)
;;; (setq Bench_width (getreal "\n不合适从新输入:"))
;;; )
;;; (setq Stepping_width (getreal "\n磴宽度:<227.5>"))
;;; (if (= Stepping_width nil)
;;; (setq Stepping_width 227.5)
;;; )
;;; (setq Bench_DN (getint "\n楼梯磴数:<5>"))
;;; (if (= Bench_DN nil)
;;; (setq Bench_DN 5)
;;; )
(progn (setq pt1 (polar pt (+ s_ang (* 1.5 pi)) 60)
pt2 (polar pt1 (+ s_ang pi) Stair_width)
)
(make_line pt1 pt2)
(setq pt3 (polar pt1 (+ s_ang (* 1.5 pi)) (* Bench_DN Stepping_width))
)
;;; (make_line pt1 pt3)
(setq n 0)
(repeat Bench_DN
(setq pt5 (polar pt3 (+ s_ang (* 0.5 pi)) (* n Stepping_width))
pt6 (polar pt5 (+ s_ang pi) Bench_width)
)
(make_line pt5 pt6)
(setq n (1+ n))
)
(setq pt13 (polar pt3 (+ s_ang pi) (* 0.5 Bench_width)))
(command "circle" pt13 30 "")
(setq pt101 (mid pt pta))
(setq pt100 (mid pt ptb))
(command "line" pt13 pt101 pt100 "")
(setq dist (/ Stair_width (cos (dtor 30)) ));;;;;;;;;;;;;QIUW1
(make_line3 pt (dtor 120))
(make_line3 pt (dtor 150))
(setq pt6 (polar pt5 (+ s_ang (dtor 90)) Bench_width)
)
;;; (make_line pt5 pt6)
;;; (command "_.group" "" "*" "" ss "")
)
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(command "UNDO" "E")
(princ)
)

(defun c:tt() 
(Form1_load) 
) 
(defun Form1_load( / dcl_id Dialog_Return key keys) 
(vl-load-com) 
(setq dcl_id (load_dialog "C:\\Documents and Settings\\qiuw1\\Desktop\\ltpm\\stair.DCL")) 
(setq Dialog_Return 2) 
(while (> Dialog_Return 1) 
  (new_dialog "stair" dcl_id) 
  (setq keys '("Stepping_w" "Stair_w" "Image1" "Bench_N""accept" "cancel")) 
  (start_image "Image1") 
  (fill_image 0 0 (dimx_tile "Image1") (dimy_tile "Image1") 0) 
  (slide_image 0 0 (dimx_tile "Image1") (dimy_tile "Image1") "C:\\Documents and Settings\\qiuw1\\Desktop\\ltpm\\stair.sld") 
  (end_image) 
   
  (foreach key keys 
   (if (eval (read (strcat key "_bak"))) (set_tile key (eval (read (strcat key "_bak"))))) 
   (action_tile key "(Action_Form1_Keys $key $value)") 
  )   
  (setq Dialog_Return (start_dialog)) 
  (cond 
   ((= Dialog_Return 1) 
    (ltpm1) 
   ) 
   ((= Dialog_Return 3) 
    (getp) 
   ) 
    
  ) 
) 
(unload_dialog dcl_id) 
(princ) 
) 
(defun Picture1 (x y) 
(print "---") 
(print (list x y)) 
(print "===") 
) 
(defun Action_Form1_Keys (key value) 
(print (list key value))(print "*-------*") 
(cond 
  ((= key "accept") 
   (Get_Form1_Data) 
          (setq Stepping_width (atof(get_tile "Stepping_w" ))) 
                        (setq Bench_DN (atof(get_tile "Bench_N"))) 
   (done_dialog 1) 
  ) 
  ((= key "cancel") 
   (done_dialog 0) 
  ) 
  ((= key "Image1") 
   (done_dialog 3) 
  ) 
  ((= key "Stair_w") 
   (done_dialog 3) 
  ) 
  ((= key "Check1") 
   () 
  ) 
) 
) 
(defun Get_Form1_Data( / key) 
(foreach key keys 
  (set (read (strcat key "_bak")) (get_tile key)) 
) 
) 
 
(defun getp() 
(setq pta (getpoint "\n插入点:")) 
(setq ptb (getpoint pta "\n楼梯宽度以及角度:")) 
) 
 
(defun err (s) 
  (if (and (/= s "console break") 
           (/= s "Function cancelled") 
           (/= s "quit/exit abort") 
      ) 
    (progn (setvar "osmode" oldos) 
           (setvar "cmdecho" oldcmd) 
           (setq *error* olderr) 
           (command "UNDO" "E") 
           (princ (strcat "\n出错时退出:" s)) 
    ) 
  ) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun mid(ptt1 ptt2) 
(setq p1x(car ptt1)) 
(setq p1y(cadr ptt1)) 
(setq p2x(car ptt2)) 
(setq p2y(cadr ptt2)) 
(setq px(/ (+ p1x p2x) 2)) 
(setq py(/ (+ p1y p2y) 2)) 
(setq mpt(list px py)) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun make_line (pts pte) 
  (entmake (list '(0 . "LINE") 
                 (cons 10 pts) 
                 (cons 11 pte) 
           ) 
  ) 
;;;  (setq en (entlast)) 
;;;  (setq ss (ssadd en ss)) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun make_line3 (pt ang) 
  (setq        pts pt 
               pte (polar pts (+ s_ang ang) (/ Stair_width (cos (dtor 30)) ))   
  ) 
  (make_line pts pte) 
;;;  (setq en (entlast)) 
;;;  (setq ss (ssadd en ss)) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun dtor (ang) (/ (* ang PI) 180)) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun ltpm1 (/ ss pta ptb Stair_width s_ang Bench_width Stepping_width Bench_DN pt pt1 pt2 pt3 pt6 pt13) 
  (command "undo" "BE") 
  (setq oldos (getvar "osmode") 
          oldcmd        (getvar "cmdecho") 
        oldlay (getvar "CLAYER") 
        olderr        *error* 
        *error*        err 
  ) 
  (setvar "cmdecho" 0) 
  (setvar "clayer" oldlay) 
  (setq ss (ssadd)) 
;;;  (setq pta (getpoint "\n插入点:")) 
;;;  (setq ptb (getpoint pta "\n:楼梯宽度以及角度:")) 
  (setq Stair_width (distance pta ptb)) 
  (setq s_ang (angle pta ptb)) 
  (setq        pt (polar pta 
                  (+ s_ang (dtor 315)) 
                  (* Stair_width (sqrt 2)) 
           ) 
  ) 
  (if (< oldos 16384) 
    (setvar "osmode" (+ oldos 16384)) 
  ) 
  (setq Bench_width Stair_width) 
   
;;;  (while (> (- Bench_width Stair_width ) 0) 
;;;    (setq Bench_width (getreal "\n不合适从新输入:")) 
;;;  ) 
;;;  (setq Stepping_width (getreal "\n磴宽度:<227.5>")) 
;;;  (if (= Stepping_width nil) 
;;;    (setq Stepping_width 227.5) 
;;;  ) 
;;;  (setq Bench_DN (getint "\n楼梯磴数:<5>")) 
;;;  (if (= Bench_DN nil) 
;;;    (setq Bench_DN 5) 
;;;  ) 
    (progn (setq pt1 (polar pt (+ s_ang (* 1.5 pi)) 60) 
                 pt2 (polar pt1 (+ s_ang pi) Stair_width) 
           ) 
 
            (make_line pt1 pt2) 
           (setq pt3 (polar pt1 (+ s_ang (* 1.5 pi)) (* Bench_DN Stepping_width)) 
           ) 
;;;            (make_line  pt1 pt3) 
           (setq n 0) 
           (repeat Bench_DN 
             (setq pt5 (polar pt3 (+ s_ang (* 0.5 pi)) (* n Stepping_width)) 
                   pt6 (polar pt5 (+ s_ang pi) Bench_width) 
             ) 
             (make_line  pt5 pt6) 
             (setq n (1+ n)) 
           ) 
 
          (setq pt13 (polar pt3  (+ s_ang pi)  (* 0.5 Bench_width))) 
          (command "circle" pt13 30 "") 
          (setq pt101 (mid pt pta)) 
          (setq pt100 (mid pt ptb)) 
          (command "line"  pt13 pt101 pt100 "")    
           (setq dist (/ Stair_width  (cos (dtor 30)) ));;;;;;;;;;;;;QIUW1 
       
           (make_line3  pt (dtor 120)) 
           (make_line3  pt (dtor 150)) 
                 (setq pt6 (polar pt5 (+ s_ang (dtor 90)) Bench_width) 
           ) 
;;;           (make_line  pt5 pt6) 
;;;         (command "_.group" "" "*" "" ss "") 
    ) 
  (setvar "osmode" oldos) 
  (setvar "cmdecho" oldcmd) 
  (command "UNDO" "E") 
  (princ) 
)

zhynt · 发表于 2011-8-5 22:50:12

请提供对话框以及其调用的幻灯

qcw911 · 发表于 2011-8-6 09:43:33

本帖最后由 qcw911 于 2011-8-6 09:44 编辑

回复 zhynt 的帖子

这个是单面楼梯的
对话框没问题
幻灯片我没有制作
只是调试时候用了别的幻灯片

下面的是双面的楼梯
如果可以的话
和并成一个最好了

;;;;
(defun err (s)
(if (and (/= s "console break")
(/= s "Function cancelled")
(/= s "quit/exit abort")
)
(progn (setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(setq *error* olderr)
(command "UNDO" "E")
(princ (strcat "\n程序错误或者退出:" s))
)
)
)
(defun mid(ptt1 ptt2)
(setq p1x(car ptt1))
(setq p1y(cadr ptt1))
(setq p2x(car ptt2))
(setq p2y(cadr ptt2))
(setq px(/ (+ p1x p2x) 2))
(setq py(/ (+ p1y p2y) 2))
(setq mpt(list px py))
)
(defun make_line (pts pte)
(entmake (list '(0 . "LINE")
;;; (cons 8 lay);qiuw1
(cons 10 pts)
(cons 11 pte)
)
)
(setq en (entlast))
(setq ss (ssadd en ss))
)
(defun make_line2 ( pt ang)
(setq pts (polar pt (+ s_ang ang) (/ gap 2))
pte (polar pts (+ s_ang ang) dist)
)
(make_line pts pte)
(setq en (entlast))
(setq ss (ssadd en ss))
)
(defun make_line3 (pt ang) ;QIUW1
(setq pts (polar pt (+ s_ang ang) (/ (/ gap 2) (cos (dtor 30)) ))
;;; pts (polar pt (+ s_ang ang) (/ gap 2))
pte (polar pts (+ s_ang ang) dist)
)
(make_line pts pte)
(setq en (entlast))
(setq ss (ssadd en ss))
)
(defun make_arc (cen Radius angs ange)
(entmake (list '(0 . "ARC")
;;; (cons 8 lay)
(cons 10 cen)
(cons 40 Radius)
(cons 50 angs)
(cons 51 ange)
)
)
(setq en (entlast))
(setq ss (ssadd en ss))
)
(defun dtor (ang) (/ (* ang PI) 180))
;;;;
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;;
(defun c:ltpm ()
(command "undo" "BE")
(setq oldos (getvar "osmode")
oldcmd (getvar "cmdecho")
oldlay (getvar "CLAYER")
olderr *error*
*error* err
)
(setvar "cmdecho" 0)
;;;;;;;;;;;;;;; (if (= (TBLOBJNAME "LAYER" "Stair") nil)
;;;;;;;;;;;;;;; (command "layer" "m" "Stair" "c" "4" "" "")
;;;;;;;;;;;;;;; )
(setvar "clayer" oldlay)
(setq ss (ssadd))
(setq pta (getpoint "\n指定插入点:"))
(setq ptb (getpoint pta "\n:输入楼梯间宽度兼绘制角度:"))
(setq Stair_width (distance pta ptb))
(setq s_ang (angle pta ptb))
(setq pt (polar pta
(+ s_ang (dtor 315))
(* 0.5 Stair_width (sqrt 2))
)
)
(if (< oldos 16384)
(setvar "osmode" (+ oldos 16384))
)
(setq Gap 60)
( setq Bench_width (/ (- Stair_width gap) 2))
;(setq Bench_width (getreal "\n输入楼梯段宽度:<790>"))
;(if (= Bench_width nil)
;(setq Bench_width 790.0)
;)
(while (> (- Bench_width (/ Stair_width 2.0)) 0)
(setq Bench_width (getreal "\n改梯段宽度不合适，从新输入:"))
)
(setq Stepping_width (getreal "\n输入踏步宽度:<227.5>"))
(if (= Stepping_width nil)
(setq Stepping_width 227.5)
)
(setq Bench_UP (getint "\n输入下梯段歩数:<2>"))
(if (= Bench_UP nil)
(setq Bench_UP 2)
)
(setq Bench_DN (getint "\n输入上梯段歩数:<4>"))
(if (= Bench_DN nil)
(setq Bench_DN 4)
)
; (setq Gap (- Stair_width (* Bench_width 2)))
;(if (/= gap 0)
(progn (setq pt1 (polar pt s_ang (/ gap 2))
pt2 (polar pt (+ s_ang pi) (/ gap 2))
)
;;; (make_arc "Stair" pt (/ gap 2) s_ang (+ s_ang pi))
(setq pt11 (polar pt (+ s_ang(/ pi 4)) (* (sqrt 2) (/ gap 2)));;;;;;;;qiuw1
pt12 (polar pt (+ s_ang (* 3 (/ pi 4))) (* (sqrt 2) (/ gap 2)));;;;;;;;qiuw1
)
(make_line pt11 pt12);qiuw1
(setq pt3 (polar pt1 (+ s_ang (* 1.5 pi)) (* Bench_DN Stepping_width))
pt4 (polar pt2 (+ s_ang (* 1.5 pi)) (* Bench_up Stepping_width))
)
;;; (make_line "Stair" pt1 pt3)
;;; (make_line "Stair" pt2 pt4)
(make_line pt11 pt3);;;;;;;;qiuw1
(make_line pt12 pt4);;;;;;;;qiuw1
(make_line pt1 (polar pt1 s_ang Bench_width))
(make_line pt2 (polar pt2 (+ s_ang pi) Bench_width))
(setq n 0)
(repeat Bench_DN
(setq pt5 (polar pt3 (+ s_ang (* 0.5 pi)) (* n Stepping_width))
pt6 (polar pt5 s_ang Bench_width)
)
(make_line pt5 pt6)
(setq n (1+ n))
)
(setq n 0)
(repeat Bench_up
(setq pt5 (polar pt4 (+ s_ang (* 0.5 pi)) (* n Stepping_width))
pt6 (polar pt5 (+ s_ang pi) Bench_width)
)
(make_line pt5 pt6)
(setq n (1+ n))
)
(setq pt13 (polar pt3 s_ang (* 0.5 Bench_width)))
(setq pt14 (polar pt4 (+ s_ang pi) (* 0.5 Bench_width)))
(command "circle" pt13 30 "")
(command "circle" pt14 30 "")
(setq pt101 (mid pt12 pta))
(setq pt100 (mid pt11 ptb))
(command "line" pt13 pt100 pt101 pt14 "")
;;; (setq dist (- (/ (+ Bench_width (/ gap 2)) (cos (dtor 30))) (/ gap 2)))
(setq dist (/ Bench_width (cos (dtor 30)) ));;;;;;;;;;;;;QIUW1
(make_line3 pt (dtor 30))
(make_line3 pt (dtor 60))
(make_line3 pt (dtor 120))
(make_line3 pt (dtor 150))
(setq pt5 (polar pt (+ s_ang (dtor 90)) (/ gap 2))
pt6 (polar pt5 (+ s_ang (dtor 90)) Bench_width)
)
(make_line pt5 pt6)
;(command "_.group" "" "*" "" ss "")
)
;)
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(command "UNDO" "E")
(princ)
)

;;;; 
(defun err (s) 
  (if (and (/= s "console break") 
           (/= s "Function cancelled") 
           (/= s "quit/exit abort") 
      ) 
    (progn (setvar "osmode" oldos) 
           (setvar "cmdecho" oldcmd) 
           (setq *error* olderr) 
           (command "UNDO" "E") 
           (princ (strcat "\n程序错误或者退出:" s)) 
    ) 
  ) 
) 
 
(defun mid(ptt1 ptt2) 
(setq p1x(car ptt1)) 
(setq p1y(cadr ptt1)) 
(setq p2x(car ptt2)) 
(setq p2y(cadr ptt2)) 
(setq px(/ (+ p1x p2x) 2)) 
(setq py(/ (+ p1y p2y) 2)) 
(setq mpt(list px py)) 
) 
 
 
 
 
(defun make_line (pts pte) 
  (entmake (list '(0 . "LINE") 
;;;                 (cons 8 lay);qiuw1 
                 (cons 10 pts) 
                 (cons 11 pte) 
           ) 
  ) 
  (setq en (entlast)) 
  (setq ss (ssadd en ss)) 
) 
(defun make_line2 ( pt ang) 
  (setq        pts (polar pt (+ s_ang ang) (/ gap 2)) 
        pte (polar pts (+ s_ang ang) dist) 
  ) 
  (make_line pts pte) 
  (setq en (entlast)) 
  (setq ss (ssadd en ss)) 
) 
(defun make_line3 (pt ang)  ;QIUW1 
  (setq        pts (polar pt (+ s_ang ang) (/ (/ gap 2)  (cos (dtor 30)) )) 
;;;                pts (polar pt (+ s_ang ang) (/ gap 2)) 
         
        pte (polar pts (+ s_ang ang) dist) 
  ) 
  (make_line pts pte) 
  (setq en (entlast)) 
  (setq ss (ssadd en ss)) 
) 
(defun make_arc        (cen Radius angs ange) 
  (entmake (list '(0 . "ARC") 
;;;                 (cons 8 lay) 
                 (cons 10 cen) 
                 (cons 40 Radius) 
                 (cons 50 angs) 
                 (cons 51 ange) 
           ) 
  ) 
  (setq en (entlast)) 
  (setq ss (ssadd en ss)) 
) 
(defun dtor (ang) (/ (* ang PI) 180)) 
;;;; 
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
;;;; 
(defun c:ltpm () 
  (command "undo" "BE") 
  (setq oldos (getvar "osmode") 
          oldcmd        (getvar "cmdecho") 
        oldlay (getvar "CLAYER") 
        olderr        *error* 
        *error*        err 
  ) 
  (setvar "cmdecho" 0) 
;;;;;;;;;;;;;;;  (if (= (TBLOBJNAME "LAYER" "Stair") nil) 
;;;;;;;;;;;;;;;    (command "layer" "m" "Stair" "c" "4" "" "") 
;;;;;;;;;;;;;;;  ) 
  (setvar "clayer" oldlay) 
  (setq ss (ssadd)) 
  (setq pta (getpoint "\n指定插入点:")) 
  (setq ptb (getpoint pta "\n:输入楼梯间宽度兼绘制角度:")) 
  (setq Stair_width (distance pta ptb)) 
  (setq s_ang (angle pta ptb)) 
  (setq        pt (polar pta 
                  (+ s_ang (dtor 315)) 
                  (* 0.5 Stair_width (sqrt 2)) 
           ) 
  ) 
  (if (< oldos 16384) 
    (setvar "osmode" (+ oldos 16384)) 
  ) 
(setq Gap 60) 
( setq Bench_width (/ (- Stair_width gap) 2)) 
  ;(setq Bench_width (getreal "\n输入楼梯段宽度:<790>")) 
  ;(if (= Bench_width nil) 
    ;(setq Bench_width 790.0) 
  ;) 
  (while (> (- Bench_width (/ Stair_width 2.0)) 0) 
    (setq Bench_width (getreal "\n改梯段宽度不合适，从新输入:")) 
  ) 
  (setq Stepping_width (getreal "\n输入踏步宽度:<227.5>")) 
  (if (= Stepping_width nil) 
    (setq Stepping_width 227.5) 
  ) 
  (setq Bench_UP (getint "\n输入下梯段歩数:<2>")) 
  (if (= Bench_UP nil) 
    (setq Bench_UP 2) 
  ) 
  (setq Bench_DN (getint "\n输入上梯段歩数:<4>")) 
  (if (= Bench_DN nil) 
    (setq Bench_DN 4) 
  ) 
  ; (setq Gap (- Stair_width (* Bench_width 2)))                   
  ;(if (/= gap 0) 
    (progn (setq pt1 (polar pt s_ang (/ gap 2)) 
                 pt2 (polar pt (+ s_ang pi) (/ gap 2)) 
           ) 
;;;           (make_arc "Stair" pt (/ gap 2) s_ang (+ s_ang pi)) 
             (setq pt11 (polar pt  (+ s_ang(/ pi 4)) (*  (sqrt 2) (/ gap 2)));;;;;;;;qiuw1 
                   pt12 (polar pt (+ s_ang  (* 3 (/ pi 4))) (*  (sqrt 2) (/ gap 2)));;;;;;;;qiuw1 
              ) 
       
           (make_line pt11 pt12);qiuw1 
           (setq pt3 (polar pt1 (+ s_ang (* 1.5 pi)) (* Bench_DN Stepping_width)) 
                 pt4 (polar pt2 (+ s_ang (* 1.5 pi)) (* Bench_up Stepping_width)) 
           ) 
;;;           (make_line "Stair" pt1 pt3) 
;;;           (make_line "Stair" pt2 pt4) 
                 (make_line  pt11 pt3);;;;;;;;qiuw1 
           (make_line  pt12 pt4);;;;;;;;qiuw1 
           (make_line  pt1 (polar pt1 s_ang Bench_width)) 
           (make_line  pt2 (polar pt2 (+ s_ang pi) Bench_width)) 
           (setq n 0) 
           (repeat Bench_DN 
             (setq pt5 (polar pt3 (+ s_ang (* 0.5 pi)) (* n Stepping_width)) 
                   pt6 (polar pt5 s_ang Bench_width) 
             ) 
             (make_line  pt5 pt6) 
             (setq n (1+ n)) 
           ) 
 
 
 
       
       
 
 
 
 
       
           (setq n 0) 
           (repeat Bench_up 
             (setq pt5 (polar pt4 (+ s_ang (* 0.5 pi)) (* n Stepping_width)) 
                   pt6 (polar pt5 (+ s_ang pi) Bench_width) 
             ) 
             (make_line  pt5 pt6) 
             (setq n (1+ n)) 
           ) 
 
 
 
 
          (setq pt13 (polar pt3  s_ang  (* 0.5 Bench_width))) 
          (setq pt14 (polar pt4  (+ s_ang pi)  (* 0.5 Bench_width))) 
          (command "circle" pt13 30 "") 
          (command "circle" pt14 30 "") 
          (setq pt101 (mid pt12 pta)) 
          (setq pt100 (mid pt11 ptb)) 
          (command "line"  pt13 pt100 pt101 pt14 "") 
       
       
;;;           (setq dist (- (/ (+ Bench_width (/ gap 2)) (cos (dtor 30))) (/ gap 2))) 
       
           (setq dist (/ Bench_width  (cos (dtor 30)) ));;;;;;;;;;;;;QIUW1 
       
           (make_line3  pt (dtor 30)) 
           (make_line3  pt (dtor 60)) 
           (make_line3  pt (dtor 120)) 
           (make_line3  pt (dtor 150)) 
           (setq pt5 (polar pt (+ s_ang (dtor 90)) (/ gap 2)) 
                 pt6 (polar pt5 (+ s_ang (dtor 90)) Bench_width) 
           ) 
           (make_line  pt5 pt6) 
          ;(command "_.group" "" "*" "" ss "") 
    ) 
  ;) 
  (setvar "osmode" oldos) 
  (setvar "cmdecho" oldcmd) 
  (command "UNDO" "E") 
  (princ) 
)

xyp1964 · 发表于 2011-8-7 09:10:23

yefei812678 · 发表于 2022-7-9 10:12:30

都是大神太厉害了

注册 · 发表于 2022-7-12 08:20:44

牛啊，这个-------

账号		自动登录	找回密码
密码			注册

[基础] 如何用lisp画出这样的楼梯呢？已解决【感谢zhynt大侠相助】

本帖子中包含更多资源

本帖子中包含更多资源

点评