提取标注尺寸进行替换

lostbalance

编了一个提取标注的尺寸，并替换文本的程序，适用于线性、对齐、半径、直径、角度和弧长标注。
注：弧长标注老版本的cad，比如04版之类的，没这个功能。

2. (defun C:DimReplace( / dim bl jd len diment dimss dimty )
   
3.   (princ "\n选择标注: ")
   
4.   (setq dim (ssget '((0 . "DIMENSION"))))
   
5.   (setq bl (getreal "\n标注比例: <1>"))
   
6.   (if (not bl) (setq bl 1))
   
7.   (setq jd (getint "\n标注精度: <0>"))
   
8.   (if (not jd) (setq jd 0))
   
9.   (if dim
   
10.     (progn
    
11.       (repeat
    
12.         (setq len (sslength dim))
    
13.         (setq diment (entget (ssname dim (setq len (1- len)))))
    
14.         (setq dimss (cdr (assoc 1 diment)))
    
15.         (if (or (= dimss "") (= dimss "<>"))
    
16.           (progn
    
17.             (setq dimty (cdr (assoc 70 diment)))
    
18.             (setq dimss (cdr (assoc 42 diment)))
    
19.             (cond
    
20.               (  (or (= dimty 32) (= dimty 160);线性
    
21.                   (= dimty 33) (= dimty 161);对齐
    
22.                   (= dimty 37) (= dimty 165);弧长
    
23.                 )
    
24.                 (setq dimss (rtos (* dimss bl) 2 jd))
    
25.               )
    
26.               ((or (= dimty 34) (= dimty 162));角度
    
27.                 (setq dimss (strcat (rtos (WYB-rtod dimss) 2 jd) "%%D"))
    
28.               )
    
29.               ((or (= dimty 35) (= dimty 163));直径
    
30.                 (setq dimss (strcat "%%C" (rtos (* dimss bl) 2 jd)))
    
31.               )
    
32.               ((or (= dimty 36) (= dimty 164));半径
    
33.                 (setq dimss (strcat "R" (rtos (* dimss bl) 2 jd)))
    
34.               )
    
35.             )
    
36.             (entmod (subst (cons 1 dimss) (assoc 1 diment) diment))
    
37.           )
    
38.         )
    
39.       )
    
40.     )
    
41.   )
    
42.   (princ "\n完成标注的文本替换")
    
43.   (princ)
    
44. )
    
45. 
    
46. 
    
47. (defun WYB-rtod(r)
    
48.   (/ (* r 180) pi)
    
49. )

(defun C:DimReplace( / dim bl jd len diment dimss dimty )<br />   (princ "\n选择标注: ")<br />   (setq dim (ssget '((0 . "DIMENSION"))))<br />   (setq bl (getreal "\n标注比例: <1>"))<br />   (if (not bl) (setq bl 1))<br />   (setq jd (getint "\n标注精度: <0>"))<br />   (if (not jd) (setq jd 0))<br />   (if dim<br />     (progn<br />       (repeat <br />         (setq len (sslength dim))<br />         (setq diment (entget (ssname dim (setq len (1- len)))))<br />         (setq dimss (cdr (assoc 1 diment)))<br />         (if (or (= dimss "") (= dimss "<>"))<br />           (progn<br />             (setq dimty (cdr (assoc 70 diment)))<br />             (setq dimss (cdr (assoc 42 diment)))<br />             (cond<br />               (  (or (= dimty 32) (= dimty 160);线性<br />                   (= dimty 33) (= dimty 161);对齐<br />                   (= dimty 37) (= dimty 165);弧长<br />                 )<br />                 (setq dimss (rtos (* dimss bl) 2 jd))<br />               )<br />               ((or (= dimty 34) (= dimty 162));角度<br />                 (setq dimss (strcat (rtos (WYB-rtod dimss) 2 jd) "%%D"))<br />               )<br />               ((or (= dimty 35) (= dimty 163));直径<br />                 (setq dimss (strcat "%%C" (rtos (* dimss bl) 2 jd)))<br />               )<br />               ((or (= dimty 36) (= dimty 164));半径<br />                 (setq dimss (strcat "R" (rtos (* dimss bl) 2 jd)))<br />               )<br />             )<br />             (entmod (subst (cons 1 dimss) (assoc 1 diment) diment))<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ "\n完成标注的文本替换")<br />   (princ)<br /> )<br /> <br /> <br /> (defun WYB-rtod(r)<br />   (/ (* r 180) pi)<br /> )

lostbalance

梦里水香 发表于 2017-8-18 16:56
标注前面有文本的话替换失败，有没有解决办法呢？

用(wcmatch dimss "*<>*)定位<>，暂存其他的文字，然后计算并替换<>为数值。
有兴趣的话，还可以试着扩充一下功能，对于原来就是文字+数值的，分离出文字，然后重新计算并替换数值。

梦里水香

标注前面有文本的话替换失败，有没有解决办法呢？

161650

很好用，不过坐标能不能也加进去？

zhl0123321

东西太好了

diy2005

楼主英明啊

lengxiaxi

看不了东西啊

scnjlwb

支持，谢谢分享！

HHJJ9898

太棒啦！！！！

xiang19751218

支持源码。

hbgsw

这个源码不错，谢谢分享。

水仙的错

看看如何，学习下