社区 › 源码共享 › 批量修改文字比例因子

hl19881005 发表于 2025-11-9 13:10:39

批量修改文字比例因子

因自己需要，找到了可以修改各种文字的宽度因子，给需要的朋友！

baby绑定命运线 发表于 2025-11-9 13:21:39

这种工具论坛不是很多吗还要收币啊。。:lol

小毛草 发表于 2025-11-9 16:34:42

;;; 批量修改CAD文字宽度因子 - 增强版
(defun C:qqv (/ *error* edata ei ent n newwid newwidstr si ss str tpy widstr success-count)
;; 错误处理函数
(defun *error* (msg)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*"))
      (princ (strcat "\n错误: " msg))
    )
    (princ)
)

;; 初始化全局变量（如果不存在）
(if (not *qqv-width*)
    (setq *qqv-width* 0.7) ; 默认宽度因子
)

;; 获取用户输入
(initget 6) ; 不允许负值
(setq newwid (getreal
    (strcat "\n请输入新的文字宽度因子 <" (rtos *qqv-width* 2 2) ">: ")
))

(if (not newwid)
    (setq newwid *qqv-width*)
    (setq *qqv-width* newwid) ; 更新记忆值
)

;; 验证宽度因子范围
(cond
    ((> newwid 10)
      (princ "\n警告: 宽度因子超过10，已自动限制为10.0")
      (setq newwid 10.0)
    )
    ((<= newwid 0)
      (princ "\n错误: 宽度因子必须大于0")
      (return)
    )
)

(princ "\n选择要修改宽度因子的文字对象: ")
(if (setq ss (ssget '((0 . "*TEXT"))))
    (progn
      (setq n -1
            success-count 0)
      
      (while (setq ent (ssname ss (setq n (1+ n))))
      (setq edata (entget ent)
            tpy (cdr (assoc 0 edata)))
      
      (if (equal tpy "TEXT")
          ;; 处理单行文字
          (progn
            (entmod (subst (cons 41 newwid) (assoc 41 edata) edata))
            (setq success-count (1+ success-count))
          )
          ;; 处理多行文字
          (progn
            (setq str (cdr (assoc 1 edata)))
            (if (process-mtext-width str newwid)
            (progn
                (entmod (subst (cons 1 (process-mtext-width str newwid)) (assoc 1 edata) edata))
                (setq success-count (1+ success-count))
            )
            )
          )
      )
      )
      
      (princ (strcat "\n操作完成! 已修改 " (itoa success-count) " 个文字对象的宽度因子为 " (rtos newwid 2 2)))
    )
    (princ "\n未选择文字对象")
)
(princ)
)

;;; 处理多行文字宽度因子
(defun process-mtext-width (str newwid / pos1 pos2 old-width-str new-width-str)
;; 查找现有的宽度控制符
(setq pos1 (vl-string-search "\\W" str))

(if pos1
    ;; 如果找到现有的宽度控制符，替换它
    (progn
      (setq pos2 (vl-string-search ";" str pos1))
      (if pos2
      (progn
          (setq old-width-str (substr str (1+ pos1) (- pos2 pos1 -1)))
          (setq new-width-str (strcat "\\W" (rtos newwid 2 4) ";"))
          (vl-string-subst new-width-str old-width-str str)
      )
      str ; 如果没有找到分号，返回原字符串
      )
    )
    ;; 如果没有找到宽度控制符，添加它
    (progn
      ;; 检查是否已有其他格式控制符
      (if (or (wcmatch str "{\\*}")
            (vl-string-search "\\" str))
      ;; 在现有格式控制符中添加宽度控制
      (strcat "{\\W" (rtos newwid 2 4) ";" (vl-string-trim "{}" str) "}")
      ;; 添加完整的格式控制
      (strcat "{\\W" (rtos newwid 2 4) ";" str "}")
      )
    )
)
)

不一样地设计 发表于 2025-11-9 23:30:28

感谢分享。

nzdog 发表于 2025-11-10 07:50:21

谢谢楼主热心分享，支持

ynhh 发表于 2025-11-10 18:07:58

小毛草 发表于 2025-11-9 16:34


谢谢分享
好象程序有问题，是不是少括号
加载就CAD卡死了

lailaifa 发表于 2025-11-12 08:20:45

动态调整包含单行和多行文字

查看完整版本: 批量修改文字比例因子