调试完了
还差随层没整了
以及一些细节
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)
)
回复 zhynt 的帖子
再次感谢大侠!
在你的基础上
解决了我的问题
我是新人以后还请你多帮忙 本帖最后由 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_linept1 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_linept5 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_line3pt (dtor 120))
(make_line3pt (dtor 150))
(setq pt6 (polar pt5 (+ s_ang (dtor 90)) Bench_width)
)
;;; (make_linept5 pt6)
;;; (command "_.group" "" "*" "" ss "")
)
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(command "UNDO" "E")
(princ)
)
请提供对话框以及其调用的幻灯 本帖最后由 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_linept11 pt3);;;;;;;;qiuw1
(make_linept12 pt4);;;;;;;;qiuw1
(make_linept1 (polar pt1 s_ang Bench_width))
(make_linept2 (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_linept5 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_linept5 pt6)
(setq n (1+ n))
)
(setq pt13 (polar pt3s_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_line3pt (dtor 30))
(make_line3pt (dtor 60))
(make_line3pt (dtor 120))
(make_line3pt (dtor 150))
(setq pt5 (polar pt (+ s_ang (dtor 90)) (/ gap 2))
pt6 (polar pt5 (+ s_ang (dtor 90)) Bench_width)
)
(make_linept5 pt6)
;(command "_.group" "" "*" "" ss "")
)
;)
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(command "UNDO" "E")
(princ)
)
都是大神太厉害了 牛啊，这个-------
页:
1
[2]