[求助]求大侠帮我改一下

acad-cad

下面的程序只能在CAD2000作用 请大侠们改一改在2005里能用 (defun C:tanh(/)
(setq an 3)
(setq b1 (getpoint "输入基点OR:"))
(setq r (getreal "外径的半径:R="))
(setq dd (getreal "弹簧丝的直径:d="))
(setq tt (getreal "节距T="))
(setq n1 (getint "有效圈数N="))
(setq delta (/ (* an pi) 180.0))
(setq n2 (/ 360 an))
;/***** 支承段数据 *************
(setq ang 0.0)
(setq n 0)
(while (<= n n2)
(setq aa (list (* r (cos ang)) (* r (sin ang)) (/ (* dd ang) (* 2.0 pi))))
(if (= n 0)
(setq fpt (list aa))
)
(if (> n 0)
(setq fpt (append fpt (list aa)))
)
(setq ang (+ delta ang))
(setq n (+ 1 n))
)
;/***** 有效段数据 **********************
(setq ang 0.0)
(setq n 0)
(while (<= n n2)
(setq aa (list (* r (cos ang)) (* r (sin ang)) (/ (* tt ang) (* 2.0 pi))))
(if (= n 0)
(setq spt (list aa))
)
(if (> n 0)
(setq spt (append spt (list aa)))
)
(setq ang (+ delta ang))
(setq n (+ 1 n))
)
;/********* 画下支承段 **********************
(command "UCS" "N" b1)
(command "3dpoly" (car fpt))
(setq i 0)
(repeat 2
(if (= i 0)
(progn
(setq n 1)
(while (< n n2)
(setq pt (nth n fpt))
(command pt)
(setq n (+ 1 n))
)
)
)
(if (> i 0)
(progn
(setq n 1)
(while (< n n2)
(setq pt (nth n fpt))
(setq pt (list (car pt) (cadr pt) (+ dd (caddr pt))))
(command pt)
(setq n (+ 1 n))
)
)
)
(setq i (+ 1 i))
)
;/******* 画有效段 ************
(setq i 0)
(repeat n1
(setq n 0)
(while (< n n2)
(setq pt (nth n spt))
(setq pt (list (car pt) (cadr pt) (+ (+ (* 2.0 dd) (* i tt)) (caddr pt))))
(command pt)
(setq n (+ 1 n))
)
(setq i (+ 1 i))
)
;/********* 画上支承段 **********************
(setq i 0)
(repeat 2
(setq n 1)
(while (< n n2)
(setq pt (nth n fpt))
(setq pt (list (car pt) (cadr pt) (+ (+ (+ (* 2.0 dd) (* n1 tt)) (caddr pt)) (* i dd))))
(command pt)
(setq n (+ 1 n))
)
(setq i (+ 1 i))
)
;/*************************
(command "")
;/***** 生成弹簧 ********************
(command "UCS" "N" "X" 90)
(command "CIRCLE" (nth 0 fpt) (/ dd 2.0))
(command "EXTRUDE" "L" "" "P" (nth 0 fpt))
(command "SLICE" "L" "" "ZX" "" '(0 5 0))
(setq pt (nth (- n2 1) fpt))
(setq pt (list 0 (+ (+ (+ (* 3.0 dd) (* n1 tt)) (caddr pt))) 0))
(command "UCS" "N" pt)
(command "SLICE" "L" "" "ZX" "" '(0 -5 0))
(princ)
)