决定研究dcl后，第一次练习作
本帖最后由 feng582304 于 2011-12-24 00:57 编辑(defun feng-dcl-make ( st / file dcl w h )
(setq file (open (setq dcl (VL-FILENAME-MKTEMP nil nil ".dcl")) "w"))
(WRITE-LINE st file)
(close file)
dcl
)
(defun c:asdf ( / dcl li )
(setq dcl (feng-dcl-make
"feng:dialog {\n
label = \"平面二跑楼梯\" ;\n
spacer_1;\n
:row {\n
:edit_box {\n
key = \"heigth\" ;\n
label = \"层高：\" ;\n
}\n
:text {\n
value = \"mm\" ;\n
}\n
}\n
:row {\n
:edit_box {\n
key = \"num\" ;\n
label = \"级数：\" ;\n
}\n
:text {\n
value = \"mm\" ;\n
}\n
}\n
:row {\n
:edit_box {\n
key = \"width1\" ;\n
label = \"步宽：\" ;\n
}\n
:text {\n
value = \"mm\" ;\n
}\n
}\n
:row {\n
:edit_box {\n
key = \"width2\" ;\n
label = \"井宽：\" ;\n
}\n
:text {\n
value = \"mm\" ;\n
}\n
}\n
spacer_1;\n
:row {\n
:text_part {\n
value = \"踏步高：\" ;\n
}\n
:text_part {\n
key = \"h1\" ;\n
value = \"163.64\" ;\n
}\n
:text_part {\n
value = \"mm\" ;\n
}\n
}\n
spacer_1;\n
ok_cancel;\n
}"))
;---------------------------------------------------------------------------------------;
;层高-heigth级数-num步宽-width1井宽-width2踏步高-h1;
;---------------------------------------------------------------------------------------;
(NEW_DIALOG "feng" (LOAD_DIALOG dcl))
(MODE_TILE "heigth" 2)
(SET_TILE "heigth" "3600")
(SET_TILE "num" "22")
(SET_TILE "width1" "280")
(SET_TILE "width2" "120")
(SET_TILE "h1" (rtos (/ 3600 22.0) 2 2))
(ACTION_TILE "heigth" "(feng-ht-2stair-hi)")
(ACTION_TILE "num" "(feng-ht-2stair-hi)")
(ACTION_TILE "accept" "(setq li (feng-ht-2stair-done))(DONE_DIALOG 1)")
(if (= (START_DIALOG) 1) (feng-ht-2stair (car li) (cadr li) (last li)))
)
(defun feng-ht-2stair-done ()
(setq width1 (FLOAT (read (GET_TILE "width1")))
width2 (FLOAT (read (GET_TILE "width2")))
num (read (GET_TILE "num"))
)
(list width1 width2 num)
)
(defun feng-ht-2stair-hi ( / h n )
(setq h (GET_TILE "heigth")
n (GET_TILE "num")
)
(cond
((or (= "" h) (not (VL-EVERY '(LAMBDA (x) (and (>= x 48) (<= x 57))) (VL-STRING->LIST h)))) (SET_TILE "heigth" "参数错误...") (SET_TILE "h1" "参数错误...") (MODE_TILE "heigth" 2))
((or (= "" n) (= "0" n) (not (VL-EVERY '(LAMBDA (x) (and (>= x 48) (<= x 57))) (VL-STRING->LIST n)))) (SET_TILE "num" "参数错误...") (SET_TILE "h1" "参数错误...") (MODE_TILE "num" 2))
(t (SET_TILE "h1" (rtos (/ (FLOAT (read h)) (read n)) 2 2)))
)
)
;-------------------------------------------------------------------------------------------------------------------------------;
; 通用函数 ;
;-------------------------------------------------------------------------------------------------------------------------------;
;坐标转换==》(feng-xytoxy1 目标点 坐标角度 新坐标点 转换开关)转换开关：非nil时，临时坐标系->ucs,否则是ucs->临时坐标系;
;-------------------------------------------------------------------------------------------------------------------------------;
(defun feng-xytoxy1 ( p ang p0 tt / dt dxy )
(if (and p0 tt)
(progn
(setq p (REVERSE (cons 1 (REVERSE p))))
(setq dt (list (list (cos ang) (- (sin ang)) 0 (car p0)) (list (sin ang) (cos ang) 0 (cadr p0)) '(0 0 1 0) '(0 0 0 1)))
)
(progn
(setq p (REVERSE (cons 1 (REVERSE (MAPCAR '- p p0)))))
(setq dt (list (list (cos ang) (sin ang) 0 0) (list (- (sin ang)) (cos ang) 0 0) '(0 0 1 0) '(0 0 0 1)))
)
)
(REVERSE (cdr (REVERSE (MAPCAR
'(LAMBDA (x)
(if (and (<= (setq dxy (apply '+ (MAPCAR '* p x))) 1e-05) (>= dxy -1e-05)) 0 dxy)
)
dt
))))
)
;---------------------------------------;
; 预览楼梯 ;
;---------------------------------------;
(defun feng-ht-2stair-make ( li / ms doc layers )
(setq ms (vla-get-ModelSpace (setq doc (vla-get-activedocument (vlax-get-acad-object))))
layers (vla-get-layers doc)
)
(if (null (TBLSEARCH "layer" "stair")) (vla-put-color (vla-add layers "stair") 2))
(MAPCAR '(LAMBDA (x)
(vla-put-layer (vla-addline ms (vlax-3d-point (car x)) (vlax-3d-point (cadr x))) "stair")
)
li
)
(redraw)
)
(defun feng-ht-2stair ( width1 width3 num / po gpo gr ang ln rn tt ttt li tempo width2 width4 lim-width *ERROR* )
(defun *ERROR* (msg)
(redraw)
)
(setq po (getpoint "\n请选择楼梯中间平台左角点:")
ang pi
ln (fix (/ num 2))
rn (- num ln)
tt t
ttt t
width2 1200
)
(princ "\n---\n")(princ ln)(princ "\n---\n")(princ rn)(princ "\n---end---\n")
(princ "\n控制参数->角度(A),踏步数(小键盘4/6),平台宽(小键盘2/8)...")
(while ttt
(setq gr (grread t 12 2))
(cond
((and (= (car gr) 5) tt) (feng-stair-grvecs
po
(setq gpo (abs (cadr (feng-xytoxy1 (if (setq tempo (OSNAP (cadr gr) "_nea")) tempo (cadr gr)) ang po nil))))
ang
width1
(if (<= width2 (setq lim-width (* (1+ (fix (/ (setq width4 (/ (- gpo width3) 2)) 10))) 10))) (setq width2 lim-width) width2)
width4
ln
rn)
)
((and (= (car gr) 5) (null tt)) (feng-stair-grvecs po gpo (setq ang (angle po (if (setq tempo (OSNAP (cadr gr) "_nea")) tempo (cadr gr)))) width1 width2 width4 ln rn))
((and (= (car gr) 2) (= (cadr gr) 52)) (if (or (>= (1+ rn) 19) (<= (1- ln) 2)) ln (setq ln (1- ln))) (setq rn (- num ln)));键盘4
((and (= (car gr) 2) (= (cadr gr) 54)) (if (or (<= (1- rn) 2) (>= (1+ ln) 19)) ln (setq ln (1+ ln))) (setq rn (- num ln)));键盘6
((and (= (car gr) 2) (= (cadr gr) 50)) (if (or (<= 1200 lim-width (setq tempo (- width2 10))) (<= lim-width 1200 tempo)) (setq width2 tempo)));键盘2
((and (= (car gr) 2) (= (cadr gr) 56)) (setq width2 (+ width2 10)));键盘8
((and (= (car gr) 2) (or (= (cadr gr) 65) (= (cadr gr) 97))) (setq tt nil));键盘A/a
((and (= (car gr) 3) (null tt)) (setq tt t))
((and (= (car gr) 3) tt) (feng-ht-2stair-make (feng-stair-grvecs po gpo ang width1 width2 width4 ln rn)) (setq ttt nil))
)
)
)
(defun feng-stair-grvecs ( po width ang width1 width2 width3 ln rn / li n )
(setq n -1)
(repeat ln
(setq li (cons (list (list (+ width2 (* (setq n (1+ n)) width1)) 0 0) (list (+ width2 (* n width1)) (- width3 60) 0)) li))
)
(setq n -1)
(repeat rn
(setq li (cons (list (list (+ width2 (* (setq n (1+ n)) width1)) (- width width3 -60) 0) (list (+ width2 (* n width1)) width 0)) li))
)
(setq n (1- (max ln rn)))
(MAPCAR '(LAMBDA (x) (setq li (cons x li)))
(list (list (list (- width2 60) (- width3 60) 0) (list (+ width2 (* n width1) 60) (- width3 60) 0))
(list (list (- width2 60) (- width3 60) 0) (list (- width2 60) (- width width3 -60) 0))
(list (list (- width2 60) (- width width3 -60) 0) (list (+ width2 (* n width1) 60) (- width width3 -60) 0))
(list (list (+ width2 (* n width1) 60) (- width3 60) 0) (list (+ width2 (* n width1) 60) (- width width3 -60) 0))
(list (list width2 width3 0) (list (+ width2 (* n width1)) width3 0))
(list (list width2 width3 0) (list width2 (- width width3) 0))
(list (list width2 (- width width3) 0) (list (+ width2 (* n width1)) (- width width3) 0))
(list (list (+ width2 (* n width1)) width3 0) (list (+ width2 (* n width1)) (- width width3) 0))
)
)
(setq li (MAPCAR '(LAMBDA (x)
(list (feng-xytoxy1 (car x) ang po t) (feng-xytoxy1 (cadr x) ang po t))
)
li
)
)
(redraw)
(MAPCAR '(LAMBDA (x)
(GRVECS (cons 2 x))
)
li
)
li
)
挺好的，还可动态拉伸 顶你一下顶你一下 初学，观摩一下 半夜睡不着爬起来看帖，顶你一下 支持下，自学成才 谢谢大家支持…… 本帖最后由 完整武器 于 2011-12-24 13:33 编辑
很好的程序啊 顶你！！支持楼主继续来个剖面的就完美了！！！ 支持一下很不错 俺第一个lisp就是画楼梯剖面，现在第一个整合dcl又是楼梯，晕，刚开始也想直接做个剖面的，但没想好要做到哪种功能深度，而且之前那个画剖面的虽没优化，可已用惯了，就算了，做个还没做过的，练习一下刚开始学习的对话框，概念成熟后 本帖最后由 qcw911 于 2011-12-26 09:38 编辑
这里的内容时怎么写的\n 怎么加的？
"feng:dialog {\n
label = \"平面二跑楼梯\" ;\n
spacer_1;\n
:row {\n
:edit_box {\n
key = \"heigth\" ;\n
label = \"层高：\" ;\n
}\n
:text {\n
value = \"mm\" ;\n
}\n
}\n
:row {\n
:edit_box {\n
key = \"num\" ;\n
label = \"级数：\" ;\n
}\n
:text {\n
value = \"mm\" ;\n
}\n
}\n
:row {\n
:edit_box {\n
key = \"width1\" ;\n
label = \"步宽：\" ;\n
}\n
:text {\n
value = \"mm\" ;\n
}\n
}\n
:row {\n
:edit_box {\n
key = \"width2\" ;\n
label = \"井宽：\" ;\n
}\n
:text {\n
value = \"mm\" ;\n
}\n
}\n
spacer_1;\n
:row {\n
:text_part {\n
value = \"踏步高：\" ;\n
}\n
:text_part {\n
key = \"h1\" ;\n
value = \"163.64\" ;\n
}\n
:text_part {\n
value = \"mm\" ;\n
}\n
}\n
spacer_1;\n
ok_cancel;\n
}" 楼主的代码对我有所启发，谢谢！ qcw911 发表于 2011-12-26 09:36 static/image/common/back.gif
怎么加\n？很奇怪的问题，不是自己输入进去的吗？晕。
页:
[1]
2