求教：cal计算大整数时错误

nt8011

Bao_lai 发表于 2018-10-17 23:07
请试一试，如果出错就用底下这个吧。

你的程序测试后结果准确，能否帮忙修改下上面程序？非常感谢！

Bao_lai

1. (defun C:CALCU (/ ss ssl i e str el nstr p p1 ll l)
   
2.     ;(if (not (member "GEOMCAL.ARX" (MAPCAR ' strcase (arx)))) ;无用代码出错
   
3.     ;      (arxload "geomcal.arx")
   
4.     ;)
   
5.    
   
6.     (setq csd (getint "\n请指定计算结果小数位精度：<2>"))
   
7.     (if (= csd nil)
   
8.         (setq csd 2)
   
9.     )
   
10.     (if (and (setq ss (ssget '((0 . "TEXT,TCH_TEXT"))))
    
11.              (setq p (getpoint "\n请输入标注点位置: "))
    
12.         )
    
13.     (progn
    
14.         (setq ssl  (sslength ss)
    
15.             i    -1
    
16.         )
    
17.         (command "cal")(command) ;先调用command函数，避免后面计算失败。
    
18.         (repeat ssl
    
19.               (setq el   (entget (ssname ss (setq i (1+ i))))
    
20.                     str  (strcat "1.0*" (cdr (assoc 1 el))) ;调整型为实数，除Bug。
    
21.                     l    (caadr (textbox (list (assoc 1 el) (assoc 40 el))))
    
22.                     ll   (+ l (* 4. (/ l (strlen (cdr (assoc 1 el))))))
    
23.               ;nstr (rtos (c:cal str) 2 csd)
    
24.               )
    
25.               (setq nstr (rtos (c:cal str) 2 csd))  ;把这个单独拿出来了
    
26.               (setq el (subst (cons 10 p) (assoc 10 el) el))
    
27.               (entmake el) ;写计算式
    
28.               (setq el (subst (cons 1 nstr) (assoc 1 el) el)
    
29.                     p1 (mapcar '+ (list ll 0. 0.) p)
    
30.                     el (subst (cons 10 p1) (assoc 10 el) el)
    
31.               )
    
32.               (entmake el);写结果
    
33.               (setq p (mapcar '+ p (list 0. (- (* 1.5 (cdr (assoc 40 el)))) 0.))) ;计算下一个插入点
    
34.         
    
35.         )
    
36.       )
    
37.     )
    
38.     (princ)
    
39. )

(defun C:CALCU (/ ss ssl i e str el nstr p p1 ll l)<br />     ;(if (not (member "GEOMCAL.ARX" (MAPCAR ' strcase (arx)))) ;无用代码出错<br />     ;      (arxload "geomcal.arx")<br />     ;)<br />     <br />     (setq csd (getint "\n请指定计算结果小数位精度：<2>"))<br />     (if (= csd nil)<br />         (setq csd 2)<br />     )<br />     (if (and (setq ss (ssget '((0 . "TEXT,TCH_TEXT"))))<br />              (setq p (getpoint "\n请输入标注点位置: "))<br />         )<br />     (progn<br />         (setq ssl  (sslength ss)<br />             i    -1<br />         )<br />         (command "cal")(command) ;先调用command函数，避免后面计算失败。<br />         (repeat ssl<br />               (setq el   (entget (ssname ss (setq i (1+ i))))<br />                     str  (strcat "1.0*" (cdr (assoc 1 el))) ;调整型为实数，除Bug。<br />                     l    (caadr (textbox (list (assoc 1 el) (assoc 40 el))))<br />                     ll   (+ l (* 4. (/ l (strlen (cdr (assoc 1 el))))))<br />               ;nstr (rtos (c:cal str) 2 csd)<br />               )<br />               (setq nstr (rtos (c:cal str) 2 csd))  ;把这个单独拿出来了<br />               (setq el (subst (cons 10 p) (assoc 10 el) el))<br />               (entmake el) ;写计算式<br />               (setq el (subst (cons 1 nstr) (assoc 1 el) el)<br />                     p1 (mapcar '+ (list ll 0. 0.) p)<br />                     el (subst (cons 10 p1) (assoc 10 el) el)<br />               )<br />               (entmake el);写结果<br />               (setq p (mapcar '+ p (list 0. (- (* 1.5 (cdr (assoc 40 el)))) 0.))) ;计算下一个插入点<br />         <br />         )<br />       )<br />     )<br />     (princ)<br /> )

Bao_lai

已编辑改正，注意查收.

nt8011

Bao_lai 发表于 2018-10-21 13:09
已编辑改正，注意查收.

经使用，完全解决了问题！   非常感谢！

菜卷鱼

(c:cal (strcat "1.0*" num))

ww8658

整形数溢出错。只支持到32767，如果要用CAL函数，可以在表达式前面加一个“0.0+”或者“1.0*”，强制转为浮点数。