尺寸前缀切换

自贡黄明儒

标注一轴，表示直径时前面要加φ，修改标注方式很麻烦，可以集中在“处理标注”的工具中

1. ;;11 尺寸前加前缀φ
   
2. (defun A-DIMENSION-Pre (/ E N OBJ SS TEXTOVERRIDE)
   
3.   (while (and (setvar "nomutt" 1)
   
4.         (princ "\n 选择尺寸,切换前缀φ")
   
5.         (setq ss (ssget ":S" '((0 . "*DIMENSION"))))
   
6.         (setvar "nomutt" 0)
   
7.    )
   
8.     (repeat (setq n (sslength ss))
   
9.       (setq e (ssname ss (setq n (1- n))))
   
10.       (setq obj (vlax-ename->vla-object e))
    
11.       (setq TextOverride (vlax-get obj 'TextOverride))
    
12.       (if (= "" TextOverride)
    
13.   (if (= (vla-get-TextPrefix obj) "%%C")
    
14.     (vla-put-TextPrefix obj "")
    
15.     (vla-put-TextPrefix obj "%%C")
    
16.   )
    
17.   (if (or  (wcmatch TextOverride "*%%C*")
    
18.     (wcmatch TextOverride "*%%c*")
    
19.     (wcmatch TextOverride "*φ*")
    
20.       )
    
21.     (progn
    
22.       (while (VL-STRING-SEARCH "%%C" TextOverride)
    
23.         (setq TextOverride
    
24.          (VL-STRING-SUBST "" "%%C" TextOverride)
    
25.         )
    
26.       )
    
27.       (while (VL-STRING-SEARCH "%%c" TextOverride)
    
28.         (setq TextOverride
    
29.          (VL-STRING-SUBST "" "%%c" TextOverride)
    
30.         )
    
31.       )
    
32.       (while (VL-STRING-SEARCH "φ" TextOverride)
    
33.         (setq TextOverride
    
34.          (VL-STRING-SUBST "" "φ" TextOverride)
    
35.         )
    
36.       )
    
37.       (vla-put-TextOverride obj TextOverride)
    
38.     )
    
39.     (vla-put-TextOverride obj (strcat "%%C" TextOverride))
    
40.   )
    
41.       )
    
42.     )
    
43.   )
    
44.   (setvar "nomutt" 0)      ;空选时执行
    
45. )

;;11 尺寸前加前缀φ<br /> (defun A-DIMENSION-Pre (/ E N OBJ SS TEXTOVERRIDE)<br />   (while (and (setvar "nomutt" 1)<br />         (princ "\n 选择尺寸,切换前缀φ")<br />         (setq ss (ssget ":S" '((0 . "*DIMENSION"))))<br />         (setvar "nomutt" 0)<br />    )<br />     (repeat (setq n (sslength ss))<br />       (setq e (ssname ss (setq n (1- n))))<br />       (setq obj (vlax-ename->vla-object e))<br />       (setq TextOverride (vlax-get obj 'TextOverride))<br />       (if (= "" TextOverride)<br />   (if (= (vla-get-TextPrefix obj) "%%C")<br />     (vla-put-TextPrefix obj "")<br />     (vla-put-TextPrefix obj "%%C")<br />   )<br />   (if (or  (wcmatch TextOverride "*%%C*")<br />     (wcmatch TextOverride "*%%c*")<br />     (wcmatch TextOverride "*φ*")<br />       )<br />     (progn<br />       (while (VL-STRING-SEARCH "%%C" TextOverride)<br />         (setq TextOverride<br />          (VL-STRING-SUBST "" "%%C" TextOverride)<br />         )<br />       )<br />       (while (VL-STRING-SEARCH "%%c" TextOverride)<br />         (setq TextOverride<br />          (VL-STRING-SUBST "" "%%c" TextOverride)<br />         )<br />       )<br />       (while (VL-STRING-SEARCH "φ" TextOverride)<br />         (setq TextOverride<br />          (VL-STRING-SUBST "" "φ" TextOverride)<br />         )<br />       )<br />       (vla-put-TextOverride obj TextOverride)<br />     )<br />     (vla-put-TextOverride obj (strcat "%%C" TextOverride))<br />   )<br />       )<br />     )<br />   )<br />   (setvar "nomutt" 0)      ;空选时执行<br /> )

paulpipi

大神工具箱能分享吗？

行天下

谢谢大神分享吗？

czb203

这个工具箱看起来很不错的样子

月下闲人

楼主辛苦了，如果能加弧长符号就好了，比如要画一个弧形的展开面，在展开面所有的尺寸前加弧形符号。

自贡黄明儒

月下闲人 发表于 2022-11-18 10:28
楼主辛苦了，如果能加弧长符号就好了，比如要画一个弧形的展开面，在展开面所有的尺寸前加弧形符号。

弧形可以在标注时直接产生 http://bbs.mjtd.com/thread-186547-1-1.html?_dsign=45057c20

390311997

谢谢楼主分享！

myairen

楼主给力，谢谢分享！！！