[求助]一个槽钢的LISP程序源码
<p>请版主看看这个程序是怎么回事，知问题出在什么地方，请版主帮忙给整整</p> <p>(new_dialog "ddcsteel" dcl_id)</p><p>===><br/>(new_dialog "ddlsteel" dcl_id)</p><p>-----------------------------------</p><p>(setq h 50<br/> b 37.0<br/> d 4.5<br/> ;t 7.0 ; T = True 别用来当变量 / 其余同<br/> thk 7.0<br/> r 7.0<br/>)</p><p>--------------------------------------<br/>再调试 / 还未通过 ....</p><p>另有些值也请给出合理值方便调试 .... (我完全外行啦!)</p> 谢谢指导,是用thk代替t,是吗，; C-steel
; prog.by HSW
(defun c:ddcsteel ( / ll dcl_id c-steel_cb bp vv x y
p1 p2 p3 p41 p42 p51 p52 p61 p62 p71 p72 p81 p82)
(defun c-steel_cb(/)
(setq leixing (get_tile "leixing"))
(setq kuandu (get_tile "kuandu"))
(setq gaodu (get_tile "gaodu"))
(setq houdu (get_tile "houdu"))
)
(defun type_cb ()
(setq vv (get_tile "type"))
(cond
((= vv "0") (setq h 50 b 37.0 d 4.5 ts 7.0 r 7.0 r1 3.5))
((= vv "1") (setq h 80 b 43.0 d 5.0 ts 8.0 r 8.0 r1 4.0))
((= vv "2") (setq h 100 b 48.0 d 5.3 ts 8.5 r 8.5 r1 4.25))
((= vv "3") (setq h 120 b 53.0 d 5.5 ts 9.0 r 9.0 r1 4.5))
((= vv "4") (setq h 160 b 63.0 d 6.5 ts 10.0 r 10.0 r1 5.0))
((= vv "5") (setq h 180 b 68.0 d 7.0 ts 10.5 r 10.5 r1 5.5))
((= vv "6") (setq h 180 b 70.0 d 9.0 ts 10.5 r 10.5 r1 5.5))
((= vv "7") (setq h 200 b 75.0 d 9.0 ts 11.0 r 11.0 r1 5.5))
((= vv "8") (setq h 220 b 79.0 d 9.0 ts 11.5 r 11.5 r1 5.75))
((= vv "9") (setq h 250 b 80.0 d 9.0 ts 12.0 r 12.0 r1 6.0))
((= vv "10") (setq h 280 b 84.0 d 9.5 ts 12.5 r 12.5 r1 6.25))
((= vv "11") (setq h 360 b 106.0 d 7.5 ts 11.7 r 14.0 r1 6.0))
)
(set_tile "kuandu" (rtos h 2 1))
(set_tile "gaodu" (rtos b 2 1))
(set_tile "houdu" (rtos d 2 1))
)
(setq olderr *error* *error* myerror)
(setq oldcmd (getvar "cmdecho"))
(setq oldosmode (getvar "osmode"))
(setq oldorthomode (getvar "orthomode"))
(setq oldlayer (getvar "clayer"))
(setvar "cmdecho" 0)
(setvar "osmode" 32)
(setq tplst
(list "[50x37X4.5" "[80x43x5.0" "[100x48x5.3" "[120x53x5.5" "[160x63x6.5" "[180x68X7.0"
"[180x70x9.0" "[200x75x9.0" "[220x79x9.0" "[250x80x9.0" "[280x84x9.5" "[360x106x7.5")
)
(initget 1)
(setq bp (getpoint "\n输入插入点:"))
(setvar "osmode" 0)
(if (< (setq dcl_id (load_dialog "ddcsteel.dcl")) 0) (exit))
(new_dialog "ddcsteel" dcl_id)
(setq x (dimx_tile "image_c") y (dimy_tile "image_c"))
(start_image "image_c")
(slide_image 0 0 x y "ddhelp(c-steel)")
(end_image)
(start_list "type")
(mapcar 'add_list tplst)
(end_list)
(action_tile "xingcai" "(xingcai_cb)")
(action_tile "yaxing" "(yaxing_cb)")
(action_tile "type" "(type_cb)")
(action_tile "accept" "(c-steel_cb)(done_dialog 2)")
(action_tile "cancel" "(done_dialog 0)")
(setq what_next (start_dialog))
(if (= what_next 2)
(if (= leixing "xingcai") (progn
; (setq h width b highth d thick)
(setq p1 (list (car bp) (+ (cadr bp) h)))
(setq p2 (list (+ (car p1) b) (cadr p1)))
(setq p3 (list (+ (car bp) b) (cadr bp)))
(setq p41 (list (- (car p2) (/ (- b d) 2)) (- (cadr p2) ts)))
(setq p42 (list (- (car p3) (/ (- b d) 2)) (+ (cadr p3) ts)))
(setq x (- (/ (- b d) 2) r1))
(setq y (/ x 10))
(setq p51 (list (+ (car p41) x) (+ (cadr p41) y)))
(setq p52 (list (+ (car p42) x) (- (cadr p42) y)))
(setq p81 (list (car p2) (+ (cadr p51) r1)))
(setq p82 (list (car p3) (- (cadr p52) r1)))
(setq x (- (/ (- b d) 2) (* r (- 1 (/ (sqrt 101) 100)))))
(setq y (/ x 10))
(setq p61 (list (- (car p41) x) (- (cadr p41) y)))
(setq p62 (list (- (car p42) x) (+ (cadr p42) y)))
(setq y (+ (/ (* 10 r) (sqrt 101)) y))
(setq p71 (list (+ (car p1) d) (- (cadr p41) y)))
(setq p72 (list (+ (car bp) d) (+ (cadr p42) y)))
(setvar "osmode" 0)
(command "layer" "s" "0" "")
(command "pline" bp p1 p2 p81 "a" p51 "l" p61 "a" p71 "l" p72 "a" p62
"l" p52 "a" p82 "l"p3 bp "")
(setq ss (ssget "l"))
(princ "\n请输入插入角度:")
(command "rotate" ss "" bp pause)
);end progn
(if (and (/= kuandu "") (/= gaodu "") (/= houdu "")) (progn
(setq kuandu (atof kuandu))
(setq gaodu (atof gaodu))
(setq houdu (atof houdu))
(setq bp1 (list (+ (car bp) gaodu) (cadr bp)))
(setq bp2 (list (+ (car bp) (* 2 houdu)) (cadr bp)))
(setq bp3 (list (car bp) (- (cadr bp) (* 2 houdu))))
(setq bp4 (list (car bp) (- (cadr bp) (- kuandu (* 2 houdu)))))
(setq bp5 (list (+ (car bp) (* 2 houdu)) (- (cadr bp) kuandu)))
(setq bp6 (list (+ (car bp) gaodu) (- (cadr bp) kuandu)))
(setq bp7 (list (+ (car bp) gaodu) (- (cadr bp) (- kuandu houdu))))
(setq bp8 (list (+ (car bp) (* 2 houdu)) (- (cadr bp) (- kuandu houdu))))
(setq bp9 (list (+ (car bp) houdu) (- (cadr bp) (- kuandu (* 2 houdu)))))
(setq bp10 (list (+ (car bp) houdu) (- (cadr bp) (* 2 houdu))))
(setq bp11 (list (+ (car bp) (* 2 houdu)) (- (cadr bp) houdu)))
(setq bp12 (list (+ (car bp) gaodu) (- (cadr bp) houdu)))
(setvar "osmode" 0)
(setvar "clayer" "0")
(command "pline" bp1 bp2 "a" bp3 "l" bp4 "a" bp5 "l" bp6 bp7 bp8 "a" bp9 "l"
bp10 "a" bp11 "l" bp12 bp1 "")
(setq ss (ssget "l"))
(princ "\n请输入插入角度:")
(command "rotate" ss "" bp pause)
);end progn
(alert "压型槽钢数据没有输入!")
);end if
);end if
);end if
(unload_dialog dcl_id)
(setvar "clayer" oldlayer)
(setvar "orthomode" oldorthomode)
(setvar "osmode" oldosmode)
(setvar "cmdecho" oldcmd)
(setq *error* olderr)
(princ "\n谢谢使用 ddcsteel 3.0!")
(princ)
)
(princ " ddcsteel 3.0 loaded.")
(princ)
<p>辛苦了版主，我刚学LISP，有好多东西还没掌握，这个是在网上下的，我试了一下其中的角钢程序就想用它的槽钢程序，结果遇到了难题，谢谢版式主了</p> 楼主把槽钢DCL文件也贴出来啊 热轧槽钢 <p>感谢楼主了。。</p> <p>添加中心线功能，比例换算功能就更完美了。</p>
页:
[1]