请教这段代码提取标注原始尺寸时，为何再刷进另一标注时个位数被取整了？请大师修改下

★飞飛★

2. ;;;---------------------------------------------------
   
3. (defun c:dg (/ p sn en p1 nam ty e1 e2 st p2 p3 p4 ss );点改文字、属性或标注尺寸为源文字内容。
   
4. ;-----------------------------------------------------
   
5. (command "undo" "g")
   
6. (setq os (getvar "osmode") blp (getvar "blipmode"))
   
7. (setvar "blipmode" 0)
   
8. (graphscr)
   
9. (if (null text0)(setq text0 ""))
   
10. (canzhao)
    
11. (while  (setq p (entsel "\n点取要改的文字、属性或标注尺寸:"))
    
12.    (setq sn  (car p)
    
13.    en  (entget sn)
    
14.    p1  (to 10)
    
15.    nam (to 2)
    
16.    ty  (to 0)
    
17.    )
    
18.    (if (or (= "TEXT" ty) (= "INSERT" ty) (= "DIMENSION" ty))
    
19.      (if (or (= "TEXT" ty) (= "DIMENSION" ty))
    
20.        (progn ;; 将文字改为参照的文字内容
    
21.         (setq e1 (subst (cons 1 st) (assoc 1 en) en))
    
22.         (entmod e1)
    
23.        ) ;progn
    
24.       
    
25.        (progn ;; 将属性改为参照的文字内容
    
26.         (setq e1 (entget (entnext (cdr (car en)))))
    
27.         (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))
    
28.         (entmod e1)
    
29.         (entmod en)
    
30.         (if (or (eq nam "PQ") (eq nam "PQ1"))
    
31.     (progn
    
32.       (setq e2 (entget (entnext (cdr (car e1)))))
    
33.       (setq e2 (subst (cons 1 st) (assoc 1 e2) e2))
    
34.       (entmod e2)
    
35.       (entmod en)
    
36.     )
    
37.         )
    
38.        ) ;progn
    
39.      )
    
40.      (progn
    
41.        (princ "n所选物体是")
    
42.        (princ (cdr (assoc 0 en)))
    
43.        (princ ", 不是文字或图块,请重新选择:n")
    
44.      )
    
45.    )
    
46. ) ;while
    
47. (setvar "blipmode" blp)
    
48. (terpri)
    
49. (command "undo" "end")
    
50. (princ "★飞飞★ 2012.6.1 修改")
    
51. (princ)
    
52. )
    
53. 
    
54. (defun to (n)
    
55.   (cdr (assoc n (entget sn)))
    
56. )
    
57. 
    
58. (defun canzhao (/ sn p13 p14) ;;提取参照文字或属性内容：
    
59.   (setq sn (car (entsel (strcat "\n点取需用参照的文字、属性或标注尺寸<" text0 ">:"))))
    
60.   (if (= sn nil)
    
61.     (setq st text0)
    
62.     (if  (or (= "TEXT" (to 0))
    
63.       (= "INSERT" (to 0))
    
64.       (= "DIMENSION" (to 0))) ;or
    
65.       (if (= "INSERT" (to 0))
    
66.   (setq st (entget (entnext (cdr (car (entget sn)))))
    
67.         st (cdr (assoc 1 st))) ;;提取属性
    
68.   (progn
    
69.     (if (= "DIMENSION" (to 0))
    
70.       (progn ;;提取尺寸
    
71.        (setq p13 (to 13)
    
72.        p14 (to 14))
    
73.        (if (eq (to 1) "")
    
74.          (setq st (* (fix (/ (+ (distance p13 p14) 4) 10)) 10)
    
75.          st (itoa st))
    
76.          (setq st (to 1))
    
77.        )
    
78.       )
    
79.       (setq st (to 1)) ;;提取文字
    
80.     )
    
81.   )
    
82.       ) ;if
    
83.       (setq st "")
    
84.     ) ;if
    
85.   ) ;if
    
86.   (setq text0 st)
    
87. )
    

;;;---------------------------------------------------<br /> (defun c:dg (/ p sn en p1 nam ty e1 e2 st p2 p3 p4 ss );点改文字、属性或标注尺寸为源文字内容。<br /> ;-----------------------------------------------------<br /> (command "undo" "g")<br /> (setq os (getvar "osmode") blp (getvar "blipmode")) <br /> (setvar "blipmode" 0)<br /> (graphscr)<br /> (if (null text0)(setq text0 ""))<br /> (canzhao)<br /> (while  (setq p (entsel "\n点取要改的文字、属性或标注尺寸:"))<br />    (setq sn  (car p)<br />    en  (entget sn)<br />    p1  (to 10)<br />    nam (to 2)<br />    ty  (to 0)<br />    )<br />    (if (or (= "TEXT" ty) (= "INSERT" ty) (= "DIMENSION" ty))<br />      (if (or (= "TEXT" ty) (= "DIMENSION" ty))<br />        (progn ;; 将文字改为参照的文字内容 <br />         (setq e1 (subst (cons 1 st) (assoc 1 en) en))<br />         (entmod e1)<br />        ) ;progn<br />        <br />        (progn ;; 将属性改为参照的文字内容<br />         (setq e1 (entget (entnext (cdr (car en)))))<br />         (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))<br />         (entmod e1)<br />         (entmod en)<br />         (if (or (eq nam "PQ") (eq nam "PQ1"))<br />     (progn<br />       (setq e2 (entget (entnext (cdr (car e1)))))<br />       (setq e2 (subst (cons 1 st) (assoc 1 e2) e2))<br />       (entmod e2)<br />       (entmod en)<br />     )<br />         )<br />        ) ;progn<br />      )<br />      (progn<br />        (princ "n所选物体是")<br />        (princ (cdr (assoc 0 en)))<br />        (princ ", 不是文字或图块,请重新选择:n")<br />      )<br />    )<br /> ) ;while<br /> (setvar "blipmode" blp)<br /> (terpri)<br /> (command "undo" "end")<br /> (princ "★飞飞★ 2012.6.1 修改")<br /> (princ)<br /> )<br /> <br /> (defun to (n)<br />   (cdr (assoc n (entget sn)))<br /> )<br /> <br /> (defun canzhao (/ sn p13 p14) ;;提取参照文字或属性内容：<br />   (setq sn (car (entsel (strcat "\n点取需用参照的文字、属性或标注尺寸<" text0 ">:"))))<br />   (if (= sn nil)<br />     (setq st text0)<br />     (if  (or (= "TEXT" (to 0))<br />       (= "INSERT" (to 0))<br />       (= "DIMENSION" (to 0))) ;or<br />       (if (= "INSERT" (to 0))<br />   (setq st (entget (entnext (cdr (car (entget sn)))))<br />         st (cdr (assoc 1 st))) ;;提取属性<br />   (progn<br />     (if (= "DIMENSION" (to 0))<br />       (progn ;;提取尺寸<br />        (setq p13 (to 13)<br />        p14 (to 14))<br />        (if (eq (to 1) "")<br />          (setq st (* (fix (/ (+ (distance p13 p14) 4) 10)) 10)<br />          st (itoa st))<br />          (setq st (to 1))<br />        )<br />       )<br />       (setq st (to 1)) ;;提取文字<br />     )<br />   )<br />       ) ;if<br />       (setq st "")<br />     ) ;if<br />   ) ;if<br />   (setq text0 st)<br /> )<br />

★飞飛★

这个问题一直困挠我很长时间了，一直修改不成功。望老师们不吝赐教，另，这段程序对于标注刷文字还是很有用处的，也可以与其它文本、块属性文字互刷，在此贴出源码，待修改完善后，希望能对各位朋友在工作中有所帮助。因为我就经常的用到，而不是手动的去改数字，那样对于我们这些懒人来说太麻烦了，呵呵。

琴剑江山_10184

涵数 rtos 可以设精度

★飞飛★

琴剑江山_10184 发表于 2014-10-26 15:03
涵数 rtos 可以设精度

这个程序里面没有用到rtos函数，我原来也试了这个的，没成功。谢谢

vectra

73行修改为

2. (setq st (fix (+ (distance p13 p14) 0.5))

(setq st (fix (+ (distance p13 p14) 0.5))

★飞飛★

vectra 发表于 2014-10-26 15:55
73行修改为

谢谢vectra老师，原来是这里的BUG。成功！有需要有朋友请上楼顶下载测试成功版本的附件。