请教这段代码提取标注原始尺寸时，为何再刷进另一标注时个位数被取整了？请大师修改下
本帖最后由 ★飞飛★ 于 2014-10-26 16:48 编辑;;;---------------------------------------------------
(defun c:dg (/ p sn en p1 nam ty e1 e2 st p2 p3 p4 ss );点改文字、属性或标注尺寸为源文字内容。
;-----------------------------------------------------
(command "undo" "g")
(setq os (getvar "osmode") blp (getvar "blipmode"))
(setvar "blipmode" 0)
(graphscr)
(if (null text0)(setq text0 ""))
(canzhao)
(while(setq p (entsel "\n点取要改的文字、属性或标注尺寸:"))
(setq sn(car p)
en(entget sn)
p1(to 10)
nam (to 2)
ty(to 0)
)
(if (or (= "TEXT" ty) (= "INSERT" ty) (= "DIMENSION" ty))
(if (or (= "TEXT" ty) (= "DIMENSION" ty))
(progn ;; 将文字改为参照的文字内容
(setq e1 (subst (cons 1 st) (assoc 1 en) en))
(entmod e1)
) ;progn
(progn ;; 将属性改为参照的文字内容
(setq e1 (entget (entnext (cdr (car en)))))
(setq e1 (subst (cons 1 st) (assoc 1 e1) e1))
(entmod e1)
(entmod en)
(if (or (eq nam "PQ") (eq nam "PQ1"))
(progn
(setq e2 (entget (entnext (cdr (car e1)))))
(setq e2 (subst (cons 1 st) (assoc 1 e2) e2))
(entmod e2)
(entmod en)
)
)
) ;progn
)
(progn
(princ "n所选物体是")
(princ (cdr (assoc 0 en)))
(princ ", 不是文字或图块,请重新选择:n")
)
)
) ;while
(setvar "blipmode" blp)
(terpri)
(command "undo" "end")
(princ "★飞飞★ 2012.6.1 修改")
(princ)
)
(defun to (n)
(cdr (assoc n (entget sn)))
)
(defun canzhao (/ sn p13 p14) ;;提取参照文字或属性内容：
(setq sn (car (entsel (strcat "\n点取需用参照的文字、属性或标注尺寸<" text0 ">:"))))
(if (= sn nil)
(setq st text0)
(if(or (= "TEXT" (to 0))
(= "INSERT" (to 0))
(= "DIMENSION" (to 0))) ;or
(if (= "INSERT" (to 0))
(setq st (entget (entnext (cdr (car (entget sn)))))
st (cdr (assoc 1 st))) ;;提取属性
(progn
(if (= "DIMENSION" (to 0))
(progn ;;提取尺寸
(setq p13 (to 13)
p14 (to 14))
(if (eq (to 1) "")
(setq st (* (fix (/ (+ (distance p13 p14) 4) 10)) 10)
st (itoa st))
(setq st (to 1))
)
)
(setq st (to 1)) ;;提取文字
)
)
) ;if
(setq st "")
) ;if
) ;if
(setq text0 st)
)
本帖最后由 ★飞飛★ 于 2014-10-25 20:23 编辑
这个问题一直困挠我很长时间了，一直修改不成功。望老师们不吝赐教，另，这段程序对于标注刷文字还是很有用处的，也可以与其它文本、块属性文字互刷，在此贴出源码，待修改完善后，希望能对各位朋友在工作中有所帮助。因为我就经常的用到，而不是手动的去改数字，那样对于我们这些懒人来说太麻烦了，呵呵。 涵数 rtos 可以设精度 琴剑江山_10184 发表于 2014-10-26 15:03 static/image/common/back.gif
涵数 rtos 可以设精度
这个程序里面没有用到rtos函数，我原来也试了这个的，没成功。谢谢 73行修改为(setq st (fix (+ (distance p13 p14) 0.5)) 本帖最后由 ★飞飛★ 于 2014-10-26 16:55 编辑
vectra 发表于 2014-10-26 15:55 static/image/common/back.gif
73行修改为
谢谢vectra老师，原来是这里的BUG。成功！有需要有朋友请上楼顶下载测试成功版本的附件。
页:
[1]