发一个添加标注前缀φ的程序，之前社区有一些不太适合自己用。

183017064

• 情况1：标注已含%%C前缀情况（跳过操作）
• 情况2：标注文字被用户修改过（非测量值）添加φ
• 情况3：标注为原始测量值（未被修改）添加φ
  

  2. (defun c:tt (/ ss i ent obj currText)
     
  3.   (vl-load-com)
     
  4.   (setq ss (ssget '((0 . "DIMENSION")))) ; 选择所有标注对象
     
  5.   (if ss
     
  6.     (progn
     
  7.       (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
     
  8.       (setq i 0)
     
  9.       (repeat (sslength ss)
     
  10.         (setq ent (ssname ss i))
      
  11.         (setq obj (vlax-ename->vla-object ent))
      
  12.         (setq currText (vla-get-TextOverride obj))
      
  13.         (cond
      
  14.           ;; 情况1：标注已含%%C前缀（跳过操作）
      
  15.           ((wcmatch currText "%%C*")
      
  16.             nil ; 不执行任何操作
      
  17.           )
      
  18.           ;; 情况2：标注文字被用户修改过（非测量值）
      
  19.           ((/= currText "")
      
  20.             (vla-put-TextOverride obj (strcat "%%C" currText))
      
  21.           )
      
  22.           ;; 情况3：标注为原始测量值（未被修改）
      
  23.           (t
      
  24.             (vla-put-TextOverride obj "%%C<>")
      
  25.           )
      
  26.         )
      
  27.         (setq i (1+ i))
      
  28.       )
      
  29.       (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) ; 结束撤销标记
      
  30.       (princ (strcat "\n已处理 " (itoa i) " 个标注。"))
      
  31.     )
      
  32.     (princ "\n未选中任何标注。")
      
  33.   )
      
  34.   (princ)
      
  35. )

  (defun c:tt (/ ss i ent obj currText)<br />   (vl-load-com)<br />   (setq ss (ssget '((0 . "DIMENSION")))) ; 选择所有标注对象<br />   (if ss<br />     (progn<br />       (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) <br />       (setq i 0)<br />       (repeat (sslength ss)<br />         (setq ent (ssname ss i))<br />         (setq obj (vlax-ename->vla-object ent))<br />         (setq currText (vla-get-TextOverride obj))<br />         (cond<br />           ;; 情况1：标注已含%%C前缀（跳过操作）<br />           ((wcmatch currText "%%C*") <br />             nil ; 不执行任何操作<br />           )<br />           ;; 情况2：标注文字被用户修改过（非测量值）<br />           ((/= currText "")<br />             (vla-put-TextOverride obj (strcat "%%C" currText)) <br />           )<br />           ;; 情况3：标注为原始测量值（未被修改）<br />           (t<br />             (vla-put-TextOverride obj "%%C<>") <br />           )<br />         )<br />         (setq i (1+ i))<br />       )<br />       (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) ; 结束撤销标记<br />       (princ (strcat "\n已处理 " (itoa i) " 个标注。"))<br />     )<br />     (princ "\n未选中任何标注。")<br />   )<br />   (princ)<br /> )
  
  

fangmin723

好几年前，我也写过，也分享下

1. ;;说明:标注批量添加直径符号
   
2. (defun C:DDAD(/ dxfstr edata ent i n obj ss)
   
3.   (vl-load-com)
   
4.   (command "UNDO" "be")
   
5.   (if (setq ss (ssget '((0 . "DIMENSION"))))
   
6.     (progn
   
7.       (setq n -1 i 0)
   
8.       (while (setq ent (ssname ss (setq n (1+ n))))
   
9.         (setq obj (vlax-ename->vla-object ent) edata (entget ent) dxfstr (assoc 1 edata))
   
10.         (if (not (or (vl-string-search "%%C" (strcase (cdr dxfstr))) (and (equal (vl-string-trim "(< >)" (cdr dxfstr)) "") (equal (strcase (vl-string-trim " " (vla-get-TextPrefix obj))) "%%C"))))
    
11.           (progn
    
12.             ;;(vla-put-TextPrefix obj "%%C")
    
13.             (entmod (subst (cons 1 (strcat "%%c" (if (= "" (cdr dxfstr)) "<>" (cdr dxfstr)))) dxfstr edata))
    
14.             (setq i (1+ i))
    
15.           )
    
16.         )
    
17.       )
    
18.       (princ (strcat "\n选择了" (itoa (sslength ss)) "个图元；处理了" (itoa i) "个图元！" ))
    
19.     )
    
20.   )
    
21.   (command "UNDO" "e")
    
22.   (prin1)
    
23. )
    
24. ;;说明:标注批量删除直径符号
    
25. (defun C:DDCD(/ dxfstr edata ent i idx n obj ss)
    
26.   (vl-load-com)
    
27.   (command "UNDO" "be")
    
28.   (if (setq ss (ssget '((0 . "DIMENSION"))))
    
29.     (progn
    
30.       (setq n -1 i 0)
    
31.       (while (setq ent (ssname ss (setq n (1+ n))))
    
32.         (setq obj (vlax-ename->vla-object ent) edata (entget ent) dxfstr (assoc 1 edata))
    
33.         (if (= (setq idx (vl-string-search "%%C" (strcase (cdr dxfstr)))) 0)
    
34.           (progn
    
35.             (entmod (subst (cons 1 (substr (cdr dxfstr) 4)) dxfstr edata))
    
36.             (setq i (1+ i))
    
37.           )
    
38.           (if (equal (strcase (vl-string-trim " " (vla-get-TextPrefix obj))) "%%C")
    
39.             (vla-put-TextPrefix obj "")
    
40.           )
    
41.         )
    
42.       )
    
43.       (princ (strcat "\n选择了" (itoa (sslength ss)) "个图元；处理了" (itoa i) "个图元！" ))
    
44.     )
    
45.   )
    
46.   (command "UNDO" "e")
    
47.   (prin1)
    
48. )

;;说明:标注批量添加直径符号<br /> (defun C:DDAD(/ dxfstr edata ent i n obj ss)<br />   (vl-load-com)<br />   (command "UNDO" "be")<br />   (if (setq ss (ssget '((0 . "DIMENSION"))))<br />     (progn<br />       (setq n -1 i 0)<br />       (while (setq ent (ssname ss (setq n (1+ n))))<br />         (setq obj (vlax-ename->vla-object ent) edata (entget ent) dxfstr (assoc 1 edata))<br />         (if (not (or (vl-string-search "%%C" (strcase (cdr dxfstr))) (and (equal (vl-string-trim "(< >)" (cdr dxfstr)) "") (equal (strcase (vl-string-trim " " (vla-get-TextPrefix obj))) "%%C"))))<br />           (progn<br />             ;;(vla-put-TextPrefix obj "%%C")<br />             (entmod (subst (cons 1 (strcat "%%c" (if (= "" (cdr dxfstr)) "<>" (cdr dxfstr)))) dxfstr edata))<br />             (setq i (1+ i))<br />           )<br />         )<br />       )<br />       (princ (strcat "\n选择了" (itoa (sslength ss)) "个图元；处理了" (itoa i) "个图元！" ))<br />     )<br />   )<br />   (command "UNDO" "e")<br />   (prin1)<br /> )<br /> ;;说明:标注批量删除直径符号<br /> (defun C:DDCD(/ dxfstr edata ent i idx n obj ss)<br />   (vl-load-com)<br />   (command "UNDO" "be")<br />   (if (setq ss (ssget '((0 . "DIMENSION"))))<br />     (progn<br />       (setq n -1 i 0)<br />       (while (setq ent (ssname ss (setq n (1+ n))))<br />         (setq obj (vlax-ename->vla-object ent) edata (entget ent) dxfstr (assoc 1 edata))<br />         (if (= (setq idx (vl-string-search "%%C" (strcase (cdr dxfstr)))) 0)<br />           (progn<br />             (entmod (subst (cons 1 (substr (cdr dxfstr) 4)) dxfstr edata))<br />             (setq i (1+ i))<br />           )<br />           (if (equal (strcase (vl-string-trim " " (vla-get-TextPrefix obj))) "%%C")<br />             (vla-put-TextPrefix obj "")<br />           )<br />         )<br />       )<br />       (princ (strcat "\n选择了" (itoa (sslength ss)) "个图元；处理了" (itoa i) "个图元！" ))<br />     )<br />   )<br />   (command "UNDO" "e")<br />   (prin1)<br /> )

paulpipi

感谢两位大神的分享