我在AXCAD上加载AutoLISP程序出现错误,是一个计算弯曲件展开长度的程序,如果都是直线不会出现错误,但如有圆弧计算就会出错,而在 AUTOCAD上运行很正常,现在我把程序传上来,,希望本版主能帮我解决这个问题.谢谢!我在这个论坛上另外版里已求助过,但没人能解决.
;calaulate length
(DEFUN ZKA(/ or sa ea ang rc ro x w rc s)
(cond ((= name "LINE")
(setq L (* Z (distance (cdr (assoc 10 ety)) (cdr (assoc 11 ety)))))
(princ "\n 直线长度 L = ")
(princ L)
)
((or (= name "ARC") (= name "CIRCLE"))
(cond ((= name "ARC")
(setq sa (cdr (assoc 50 ety)))
(setq ea (cdr (assoc 51 ety)))
(setq ang (abs (- ea sa)))
(if (> ang pi) (setq ang (- (* 2 pi) ang)))
)
)
(setq ro (cdr (assoc 40 ety)))
(setq x (/ ro t))
(setq w ro)
(if (= w 0.0)
(progn
(if (<= t 0.3) (setq rc (/ (* 0.8 t) pi)))
(if (and (> t 0.3) (<= t 0.4)) (setq rc (/ (* 0.75 t) pi)))
(if (and (> t 0.4) (<= t 0.5)) (setq rc (/ (* 0.8 t) pi)))
(if (and (> t 0.5) (<= t 0.6)) (setq rc (/ (* 0.83333333 t) pi)))
(if (and (> t 0.6) (<= t 0.7)) (setq rc (/ (* 0.85714286 t) pi)))
(if (and (> t 0.7) (<= t 0.8)) (setq rc (/ (* 0.875 t) pi)))
(if (and (> t 0.8) (<= t 1.0)) (setq rc (/ (* 0.9 t) pi)))
(if (and (> t 1.0) (<= t 1.1)) (setq rc (/ (* 0.90909091 t) pi)))
(if (and (> t 1.1) (<= t 1.2)) (setq rc (/ (* 0.91666666 t) pi)))
(if (> t 1.2) (setq rc (/ t pi)))
)
)
(if (/= w 0.0)
(progn
(if (and (> x 0.00) (<= x 0.10)) (setq rc (+ ro (* 0.183 t))))
(if (and (> x 0.10) (<= x 0.15)) (setq rc (+ ro (* 0.1850 t))))
(if (and (> x 0.15) (<= x 0.20)) (setq rc (+ ro (* 0.1880 t))))
(if (and (> x 0.20) (<= x 0.25)) (setq rc (+ ro (* 0.190 t))))
(if (and (> x 0.25) (<= x 0.30)) (setq rc (+ ro (* 0.1940 t))))
(if (and (> x 0.30) (<= x 0.32)) (setq rc (+ ro (* 0.201 t))))
(if (and (> x 0.32) (<= x 0.34)) (setq rc (+ ro (* 0.2060 t))))
(if (and (> x 0.34) (<= x 0.35)) (setq rc (+ ro (* 0.2090 t))))
(if (and (> x 0.35) (<= x 0.36)) (setq rc (+ ro (* 0.2130 t))))
(if (and (> x 0.36) (<= x 0.38)) (setq rc (+ ro (* 0.2190 t))))
(if (and (> x 0.38) (<= x 0.40)) (setq rc (+ ro (* 0.2260 t))))
(if (and (> x 0.41) (<= x 0.42)) (setq rc (+ ro (* 0.230 t))))
(if (and (> x 0.42) (<= x 0.43)) (setq rc (+ ro (* 0.2330 t))))
(if (and (> x 0.43) (<= x 0.46)) (setq rc (+ ro (* 0.237 t))))
(if (and (> x 0.46) (<= x 0.49)) (setq rc (+ ro (* 0.245 t))))
(if (and (> x 0.49) (<= x 0.51)) (setq rc (+ ro (* 0.250 t))))
(if (and (> x 0.51) (<= x 0.54)) (setq rc (+ ro (* 0.257 t))))
(if (and (> x 0.54) (<= x 0.56)) (setq rc (+ ro (* 0.261 t))))
(if (and (> x 0.56) (<= x 0.58)) (setq rc (+ ro (* 0.264 t))))
(if (and (> x 0.58) (<= x 0.61)) (setq rc (+ ro (* 0.270 t))))
(if (and (> x 0.61) (<= x 0.64)) (setq rc (+ ro (* 0.274 t))))
(if (and (> x 0.64) (<= x 0.68)) (setq rc (+ ro (* 0.281 t))))
(if (and (> x 0.68) (<= x 0.71)) (setq rc (+ ro (* 0.286 t))))
(if (and (> x 0.71) (<= x 0.73)) (setq rc (+ ro (* 0.288 t))))
(if (and (> x 0.73) (<= x 0.78)) (setq rc (+ ro (* 0.294 t))))
(if (and (> x 0.78) (<= x 0.81)) (setq rc (+ ro (* 0.301 t))))
(if (and (> x 0.81) (<= x 0.84)) (setq rc (+ ro (* 0.305 t))))
(if (and (> x 0.84) (<= x 0.86)) (setq rc (+ ro (* 0.309 t))))
(if (and (> x 0.86) (<= x 0.90)) (setq rc (+ ro (* 0.314 t))))
(if (and (> x 0.90) (<= x 1.1)) (setq rc (+ ro (* 0.324 t))))
(if (and (> x 1.10) (<= x 1.12)) (setq rc (+ ro (* 0.334 t))))
(if (and (> x 1.12) (<= x 1.20)) (setq rc (+ ro (* 0.341 t))))
(if (and (> x 1.2) (<= x 1.25)) (setq rc (+ ro (* 0.348 t))))
(if (and (> x 1.25) (<= x 1.34)) (setq rc (+ ro (* 0.354 t))))
(if (and (> x 1.34) (<= x 1.42)) (setq rc (+ ro (* 0.361 t))))
(if (and (> x 1.42) (<= x 1.50)) (setq rc (+ ro (* 0.369 t))))
(if (and (> x 1.50) (<= x 1.6)) (setq rc (+ ro (* 0.376 t))))
(if (and (> x 1.6) (<= x 1.68)) (setq rc (+ ro (* 0.38 t))))
(if (and (> x 1.68) (<= x 1.72)) (setq rc (+ ro (* 0.384 t))))
(if (and (> x 1.72) (<= x 1.78)) (setq rc (+ ro (* 0.387 t))))
(if (and (> x 1.78) (<= x 1.88)) (setq rc (+ ro (* 0.393 t))))
(if (and (> x 1.88) (<= x 2)) (setq rc (+ ro (* 0.4 t))))
(if (and (> x 2) (<= x 2.2)) (setq rc (+ ro (* 0.406 t))))
(if (and (> x 2.2) (<= x 2.25)) (setq rc (+ ro (* 0.412 t))))
(if (and (> x 2.25) (<= x 2.4)) (setq rc (+ ro (* 0.418 t))))
(if (and (> x 2.4) (<= x 2.6)) (setq rc (+ ro (* 0.425 t))))
(if (and (> x 2.6) (<= x 2.7)) (setq rc (+ ro (* 0.431 t))))
(if (and (> x 2.7) (<= x 2.86)) (setq rc (+ ro (* 0.439 t))))
(if (and (> x 2.86) (<= x 3)) (setq rc (+ ro (* 0.444 t))))
(if (and (> x 3) (<= x 3.2)) (setq rc (+ ro (* 0.450 t))))
(if (and (> x 3.2) (<= x 3.4)) (setq rc (+ ro (* 0.457 t))))
(if (and (> x 3.4) (<= x 3.5)) (setq rc (+ ro (* 0.460 t))))
(if (and (> x 3.5) (<= x 3.8)) (setq rc (+ ro (* 0.465 t))))
(if (and (> x 3.8) (<= x 4.0)) (setq rc (+ ro (* 0.47 t))))
(if (and (> x 4.0) (<= x 4.2)) (setq rc (+ ro (* 0.48 t))))
(if (and (> x 4.2) (<= x 4.4)) (setq rc (+ ro (* 0.485 t))))
(if (and (> x 4.4) (<= x 4.5)) (setq rc (+ ro (* 0.49 t))))
(if (and (> x 4.5) (<= x 4.8)) (setq rc (+ ro (* 0.495 t))))
(if (and (> x 4.8) (< x 5)) (setq rc (+ ro (* 0.498 t))))
(if (> x 5) (setq rc (+ ro (* 0.5 t))))
)
)
(cond ((= name "ARC")
(setq L (* Z rc ang))
(princ "\n 圆弧,展开为 L = ")
(princ L)
)
((= name "CIRCLE")
(setq L (* 2 Z pi rc))
(princ "\n 圆弧,展开为 L = ")
(princ L)
)
)
)
(T (princ "\n 请"))
)
(setq I (+ I 1))
(setq s (getstring T "\n 请按任意键继续....\n"))
)
;calculat length
(defun CL(/ sa ea ro ang s)
(textscr)
(cond ((= name "LINE")
(setq L (* Z (distance (cdr (assoc 10 ety)) (cdr (assoc 11 ety)))))
(princ "\n 直线长度 L = ")
(princ L)
)
((= name "ARC")
(setq sa (cdr (assoc 50 ety)))
(setq ea (cdr (assoc 51 ety)))
(setq ro (cdr (assoc 40 ety)))
(setq ang (- ea sa))
(if (< ang 0 ) (setq ang (- (* 2 pi) (abs ang))))
(setq L (* ro Z ang))
(princ "\n 圆弧周长 L = ")
(princ L)
)
((= name "CIRCLE")
(setq ro (cdr (assoc 40 ety)))
(setq L (* 2 Z pi ro))
(princ "\n 圆周长 L = ")
(princ L)
)
(T (princ "\n 请"))
)
(setq I (+ I 1))
(setq s (getstring T "\n请按任意键继续...."))
)
;command
(defun c:ZK(/ c sst n i tl pl l P CCL ety name pa pb pc pd)
(setvar "cmdecho" 0)
(textscr)
(print " 1. 计算周长 " )
(print " 2. 计算展开 " )
(initget (+ 1 2 4))
(setq c (getint "\n 请选择 ( 1 2 ) "))
(setq t (getreal "\n 请输入材料厚度 t = "))
(setq z (getvar "dimlfac"))
(setq sst (ssget))
(setq n (sslength sst))
(setq I 0)
(setq tl 0)
(setq l 0)
(while (< I n)
(setq ety (entget (ssname sst I)))
(setq name (cdr (assoc 0 ety)))
(cond ((= c 1) (CL))
((= c 2) (ZKA)))
(setq TL (+ TL L))
)
(cond ((= c 1) (princ "\n 总长 L = ") (princ TL)
(SETQ P (fix (* 0.045 TL T)))
(initget 128 "Yes No")
(setq ccl(getkword "\n 是否计算冲裁力(Y/N): "))
(if (= ccl "Yes") (PRogn (princ "\n 冲裁力 P=")(PRINC P)(PRINC "(吨)")))
(if (/= ccl "Yes")(princ "\n ****** 否 ****** "))
(prin1))
((= c 2)(princ "\n 总长 L = ") (princ TL)
(setq pa (getpoint "\n 请输入点坐标:"))
(if (null pa) (setq pa (list 40 100)))
(setq pb (polar pa 0 (/ tL Z)))
(setq pc (polar pb (/ pi 2) (/ t z)))
(setq pd (polar pa (/ pi 2) (/ t z)))
(setq OLSOS (GETvar "OSMODE"))
(SETvar "OSMODE" 0)
(command "pline" pa pb pc pd "c")
(princ)
(SETvar "OSMODE" OLSOS)
(prin1)
)))
;;;_______________________________________________________
(princ "\n 展开长度: ********C:ZK********")
附件:
ZK.rar