183017064 发表于 5 天前

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

本帖最后由 183017064 于 2025-3-7 13:30 编辑


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

fangmin723 发表于 5 天前

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

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


paulpipi 发表于 前天 11:59

感谢两位大神的分享

tanxindong 发表于 前天 16:10

太棒了，感谢两位大神的分享
页: [1]
查看完整版本: 发一个添加标注前缀φ的程序，之前社区有一些不太适合自己用。