文字居中（分组优化版）,支持每个表格里有多个单双行文字，位置不变）
本帖最后由 小毛草 于 2025-12-6 16:29 编辑;;;;;;;;;;;;;;;;;;;;;文字居中（分组优化版）;;;;;;;;;;;;;;;;;;
(defun C:dda (/ *error* acadDoc ss startTime count i ent obj pt0 pt1
oldregenmode olddragmode oldblipmode oldosmode oldhighlight
text-centers boundary-data groups group-list moved-entlist)
(setvar "CMDECHO" 0)
(vl-load-com)
; 保存并设置优化系统变量
(setq oldregenmode (getvar "REGENMODE")
olddragmode (getvar "DRAGMODE")
oldblipmode (getvar "BLIPMODE")
oldosmode (getvar "OSMODE")
oldhighlight (getvar "HIGHLIGHT")); 保存原始高亮设置
(setvar "REGENMODE" 0) ; 关闭自动重生成
(setvar "DRAGMODE" 0) ; 关闭拖动显示
(setvar "BLIPMODE" 0) ; 关闭点标记
(setvar "QTEXTMODE" 0) ; 确保文字正常显示
; 先设置高亮，以便选择时能看到高亮显示
(setvar "HIGHLIGHT" 1)
(setvar "OSMODE" 0) ; 关闭对象捕捉
(defun *error* (msg)
; 恢复系统变量
(setvar "REGENMODE" oldregenmode)
(setvar "DRAGMODE" olddragmode)
(setvar "BLIPMODE" oldblipmode)
(setvar "HIGHLIGHT" oldhighlight); 恢复原始高亮设置
(setvar "OSMODE" oldosmode)
(if acadDoc (vla-endundomark acadDoc))
(setvar "CMDECHO" 1)
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*"))
(princ (strcat "\n错误: " msg))
)
(princ)
)
; 快速计算文字中心点（基于插入点或几何中心）
(defun get-text-center (obj / insPt bbMin bbMax)
(if (and obj (not (vlax-erased-p obj)))
(progn
; 尝试获取插入点（对于TEXT）
(if (vlax-property-available-p obj 'InsertionPoint)
(progn
(setq insPt (vlax-safearray->list
(vlax-variant-value
(vla-get-InsertionPoint obj))))
insPt
)
; 否则使用边界框中心（对于MTEXT）
(progn
(vla-getboundingbox obj 'bbMin 'bbMax)
(setq bbMin (vlax-safearray->list bbMin)
bbMax (vlax-safearray->list bbMax))
(list (* 0.5 (+ (car bbMin) (car bbMax)))
(* 0.5 (+ (cadr bbMin) (cadr bbMax)))
(* 0.5 (+ (caddr bbMin) (caddr bbMax))))
)
)
)
nil
)
)
; 获取边界中心点
(defun get-boundary-center (pt / oldcmdecho en tmp-obj center-pt)
(setq oldcmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setvar "HPBOUND" 0) ; 创建多段线而非面域
(setq center-pt nil)
; 尝试创建边界
(if (setq en (bpoly pt))
(if (entget en)
(progn
(setq tmp-obj (vlax-ename->vla-object en))
; 获取边界中心
(vla-getboundingbox tmp-obj 'minpoint 'maxpoint)
(setq minpoint (vlax-safearray->list minpoint)
maxpoint (vlax-safearray->list maxpoint))
(setq center-pt (list (* 0.5 (+ (car minpoint) (car maxpoint)))
(* 0.5 (+ (cadr minpoint) (cadr maxpoint)))
0.0))
(entdel en)
)
)
)
(setvar "CMDECHO" oldcmdecho)
center-pt
)
; 获取一组文字的整体边界框
(defun get-group-bounding-box (objs / obj minpoint maxpoint
minX minY maxX maxY first-obj)
(if objs
(progn
(setq first-obj (car objs))
(vla-getboundingbox first-obj 'minpoint 'maxpoint)
(setq minX (car (vlax-safearray->list minpoint))
minY (cadr (vlax-safearray->list minpoint))
maxX (car (vlax-safearray->list maxpoint))
maxY (cadr (vlax-safearray->list maxpoint)))
; 遍历其余对象
(foreach obj (cdr objs)
(vla-getboundingbox obj 'minpoint 'maxpoint)
(setq pt-min (vlax-safearray->list minpoint)
pt-max (vlax-safearray->list maxpoint))
(setq minX (min minX (car pt-min))
minY (min minY (cadr pt-min))
maxX (max maxX (car pt-max))
maxY (max maxY (cadr pt-max)))
)
; 返回整体边界框的中心
(list (* 0.5 (+ minX maxX))
(* 0.5 (+ minY maxY))
0.0)
)
nil
)
)
(princ "\n选择需要居中的文字对象：")
; 使用过滤器选择文字对象（此时高亮显示）
(if (setq ss (ssget '((0 . "TEXT,MTEXT,ATTRIB"))))
(progn
; 保存原始选择集以便后续恢复
(setq original-ss ss)
; 开始处理前关闭高亮显示
(setvar "HIGHLIGHT" 0)
(setq startTime (getvar "MILLISECS"))
(setq acadDoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark acadDoc)
; 预计算选择集长度
(setq sslen (sslength ss)
count 0
i 0
moved-entlist '()); 用于存储移动过的图元名
; 第一阶段：收集文字对象和它们的中心点
(setq text-centers '())
(while (< i sslen)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
; 检查是否为文字对象
(if (and obj (wcmatch (vla-get-objectname obj) "*Text*,*Mtext*,*Attribute*"))
(progn
(setq center-pt (get-text-center obj))
(if center-pt
(setq text-centers (cons (list center-pt obj) text-centers))
)
)
)
(setq i (1+ i))
)
(setq total-texts (length text-centers))
(princ (strcat "\n找到 " (itoa total-texts) " 个文字对象"))
; 第二阶段：获取每个文字对应的边界中心点，并按边界中心点分组
(setq boundary-data '()
groups '()); 分组列表：((边界中心点 文字对象列表) ...)
(foreach tc text-centers
(setq pt0 (car tc)
obj (cadr tc))
; 获取边界中心点
(setq pt1 (get-boundary-center pt0))
; 如果获取边界中心失败，使用文字当前位置
(if (not pt1)
(setq pt1 pt0)
)
; 添加到边界数据列表
(setq boundary-data (cons (list pt0 pt1 obj) boundary-data))
; 按边界中心点分组
(setq found-group nil)
(foreach group groups
(if (and (cadr group)
(equal pt1 (cadr group) 0.001)); 比较边界中心点
(progn
; 添加到现有组
(setq obj-list (car group))
(setq obj-list (cons obj obj-list))
(setq groups (subst (list obj-list pt1) group groups))
(setq found-group t)
)
)
)
; 如果没有找到匹配的组，创建新组
(if (not found-group)
(setq groups (cons (list (list obj) pt1) groups))
)
)
(princ (strcat "\n分组完成，共 " (itoa (length groups)) " 个组"))
; 第三阶段：按组移动文字
(foreach group groups
(setq obj-list (car group) ; 组内的文字对象列表
target-pt (cadr group)) ; 目标中心点
; 计算组内所有文字的整体中心点
(setq group-center (get-group-bounding-box obj-list))
(if (and group-center target-pt
(not (equal group-center target-pt 0.001)))
(progn
; 计算偏移量
(setq offset-x (- (car target-pt) (car group-center))
offset-y (- (cadr target-pt) (cadr group-center)))
; 移动组内所有文字
(foreach obj obj-list
(setq obj-center (get-text-center obj))
(if obj-center
(progn
(setq new-pt (list (+ (car obj-center) offset-x)
(+ (cadr obj-center) offset-y)
0.0))
(vla-move obj (vlax-3d-point obj-center) (vlax-3d-point new-pt))
(setq count (1+ count))
; 记录移动过的图元名
(setq moved-entlist (cons (vlax-vla-object->ename obj) moved-entlist))
)
)
)
(princ (strcat "\n组移动: " (itoa (length obj-list)) " 个文字移动到边界中心"))
)
(princ (strcat "\n组已居中，跳过: " (itoa (length obj-list)) " 个文字"))
)
)
(vla-endundomark acadDoc)
; 显示处理时间
(setq elapsed (- (getvar "MILLISECS") startTime))
(if (> elapsed 0)
(princ (strcat "\n\n操作完成，共移动 " (itoa count) " 个文字对象"
"\n处理总数: " (itoa total-texts) "，耗时 "
(rtos (/ elapsed 1000.0) 2 3) " 秒"))
(princ (strcat "\n\n操作完成，共移动 " (itoa count) " 个文字对象"))
)
)
(progn
(princ "\n没有选择文字对象！")
(setvar "HIGHLIGHT" oldhighlight); 恢复原始高亮设置
(setvar "CMDECHO" 1)
(princ)
)
)
; 恢复系统变量
(setvar "REGENMODE" oldregenmode)
(setvar "DRAGMODE" 2)
(setvar "BLIPMODE" oldblipmode)
(setvar "HIGHLIGHT" oldhighlight); 恢复原始高亮设置
(setvar "OSMODE" oldosmode)
(setvar "CMDECHO" 1)
; 取消选择集（清除任何选择）
(sssetfirst nil nil)
; 最后进行一次重生成（如果需要）
(if (and (> count 0) (= oldregenmode 1))
(command "_.REGEN")
)
; 强制垃圾回收
(gc)
(princ)
)
;;; 增强版：显示分组详细信息
(defun C:dda-group (/ *error* ss groups moved-entlist)
(setvar "CMDECHO" 0)
(vl-load-com)
(defun *error* (msg)
; 恢复系统变量
(setvar "HIGHLIGHT" 1); 确保恢复高亮
(setvar "CMDECHO" 1)
(princ)
)
; 获取边界中心点（简化版）
(defun get-bpoly-center (pt / en center)
(setq center nil)
(if (setq en (bpoly pt))
(if (entget en)
(progn
(setq tmp-obj (vlax-ename->vla-object en))
(vla-getboundingbox tmp-obj 'minpoint 'maxpoint)
(setq minpoint (vlax-safearray->list minpoint)
maxpoint (vlax-safearray->list maxpoint))
(setq center (list (* 0.5 (+ (car minpoint) (car maxpoint)))
(* 0.5 (+ (cadr minpoint) (cadr maxpoint)))
0.0))
(entdel en)
)
)
)
center
)
; 获取文字插入点
(defun get-text-insertion (obj)
(if (vlax-property-available-p obj 'InsertionPoint)
(vlax-safearray->list
(vlax-variant-value
(vla-get-InsertionPoint obj)))
nil
)
)
; 设置高亮以便选择时能看到
(setvar "HIGHLIGHT" 1)
(princ "\n选择需要分析和分组的文字对象：")
(if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
(progn
; 开始处理前关闭高亮
(setvar "HIGHLIGHT" 0)
(setq total (sslength ss)
i 0
groups '()
moved-entlist '())
(princ (strcat "\n分析 " (itoa total) " 个文字对象..."))
; 收集所有文字并分组
(while (< i total)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(if (wcmatch (vla-get-objectname obj) "*Text*")
(progn
(setq ins-pt (get-text-insertion obj))
(if ins-pt
(progn
(setq boundary-center (get-bpoly-center ins-pt))
; 如果没有获取到边界中心，使用文字自身位置
(if (not boundary-center)
(setq boundary-center ins-pt)
)
; 按边界中心点分组
(setq found nil)
(foreach group groups
(if (equal boundary-center (cadr group) 0.001)
(progn
; 添加到现有组
(setq obj-list (car group))
(setq obj-list (cons obj obj-list))
(setq groups (subst (list obj-list boundary-center) group groups))
(setq found t)
)
)
)
; 创建新组
(if (not found)
(setq groups (cons (list (list obj) boundary-center) groups))
)
)
)
)
)
(setq i (1+ i))
; 显示进度
(if (= (rem i 50) 0)
(princ (strcat "\r已分析: " (itoa i) "/" (itoa total)))
)
)
; 显示分组结果
(princ (strcat "\n\n分组结果: " (itoa (length groups)) " 个组"))
(setq group-num 1)
(foreach group groups
(setq obj-list (car group)
boundary-center (cadr group)
group-size (length obj-list))
(princ (strcat "\n组 " (itoa group-num) ": " (itoa group-size) " 个文字"))
(if (> group-size 1)
(princ " (将整体移动)"))
(setq group-num (1+ group-num))
)
; 询问是否执行移动
(initget "Yes No")
(setq answer (getkword "\n\n是否执行居中操作？ <Y>: "))
(if (or (null answer) (= answer "Yes"))
(progn
(setq count 0)
; 执行分组移动
(foreach group groups
(setq obj-list (car group)
target-pt (cadr group))
; 计算组的整体边界框
(setq minX 1e99 minY 1e99 maxX -1e99 maxY -1e99)
(foreach obj obj-list
(vla-getboundingbox obj 'minpoint 'maxpoint)
(setq pt-min (vlax-safearray->list minpoint)
pt-max (vlax-safearray->list maxpoint))
(setq minX (min minX (car pt-min))
minY (min minY (cadr pt-min))
maxX (max maxX (car pt-max))
maxY (max maxY (cadr pt-max)))
)
(setq group-center (list (* 0.5 (+ minX maxX))
(* 0.5 (+ minY maxY))
0.0))
; 计算偏移
(setq offset-x (- (car target-pt) (car group-center))
offset-y (- (cadr target-pt) (cadr group-center)))
; 移动组内所有文字
(foreach obj obj-list
(setq obj-center (get-text-insertion obj))
(if obj-center
(progn
(setq new-pt (list (+ (car obj-center) offset-x)
(+ (cadr obj-center) offset-y)
0.0))
(vla-move obj (vlax-3d-point obj-center) (vlax-3d-point new-pt))
(setq count (+ count 1))
; 记录移动过的图元名
(setq moved-entlist (cons (vlax-vla-object->ename obj) moved-entlist))
)
)
)
)
(princ (strcat "\n操作完成，移动 " (itoa count) " 个文字对象"))
)
(princ "\n操作取消")
)
)
(princ "\n未选择文字对象！")
)
; 恢复高亮设置，但不选择对象
(setvar "HIGHLIGHT" 1)
; 取消选择集（清除任何选择）
(sssetfirst nil nil)
(setvar "CMDECHO" 1)
(princ)
)
本帖最后由 小毛草 于 2025-12-6 11:58 编辑
支持天正文字版，可以试下，未测试!;;;;;;;;;;;;;;;;;;;;文字居中（支持天正版）;;;;;;;;;;;;;;;;;;
(defun C:dda (/ *error* acadDoc ss startTime count i ent obj pt0 pt1
oldregenmode olddragmode oldblipmode oldosmode
text-centers boundary-data groups)
(setvar "CMDECHO" 0)
(vl-load-com)
; 保存并设置优化系统变量
(setq oldregenmode (getvar "REGENMODE")
olddragmode (getvar "DRAGMODE")
oldblipmode (getvar "BLIPMODE")
oldosmode (getvar "OSMODE"))
(setvar "REGENMODE" 0) ; 关闭自动重生成
(setvar "DRAGMODE" 0) ; 关闭拖动显示
(setvar "BLIPMODE" 0) ; 关闭点标记
(setvar "HIGHLIGHT" 0) ; 关闭高亮显示
(setvar "QTEXTMODE" 0) ; 确保文字正常显示
(setvar "OSMODE" 0) ; 关闭对象捕捉
(defun *error* (msg)
; 恢复系统变量
(setvar "REGENMODE" oldregenmode)
(setvar "DRAGMODE" olddragmode)
(setvar "BLIPMODE" oldblipmode)
(setvar "HIGHLIGHT" 1)
(setvar "OSMODE" oldosmode)
(if acadDoc (vla-endundomark acadDoc))
(setvar "CMDECHO" 1)
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*"))
(princ (strcat "\n错误: " msg))
)
(princ)
)
; 判断是否为文字对象（支持天正）
(defun is-text-object (obj)
(if obj
(let ((obj-type (vla-get-objectname obj)))
(wcmatch (strcase obj-type)
"*TEXT*,*MTEXT*,*ATTRIB*,*TCH_*TEXT*,*TCH_*MTEXT*")
)
nil
)
)
; 快速计算文字中心点（支持天正文字）
(defun get-text-center (obj / insPt bbMin bbMax textString textHeight rotation)
(if (and obj (not (vlax-erased-p obj)) (is-text-object obj))
(progn
; 尝试获取插入点（对于TEXT和天正文字）
(if (vlax-property-available-p obj 'InsertionPoint)
(progn
(setq insPt (vlax-safearray->list
(vlax-variant-value
(vla-get-InsertionPoint obj))))
insPt
)
; 否则使用边界框中心
(progn
(vla-getboundingbox obj 'bbMin 'bbMax)
(setq bbMin (vlax-safearray->list bbMin)
bbMax (vlax-safearray->list bbMax))
(list (* 0.5 (+ (car bbMin) (car bbMax)))
(* 0.5 (+ (cadr bbMin) (cadr bbMax)))
(* 0.5 (+ (caddr bbMin) (caddr bbMax))))
)
)
)
nil
)
)
; 获取边界中心点
(defun get-boundary-center (pt / oldcmdecho en tmp-obj center-pt)
(setq oldcmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setvar "HPBOUND" 0) ; 创建多段线而非面域
(setq center-pt nil)
; 尝试创建边界（最多尝试3次）
(repeat 3
(if (not center-pt)
(progn
(if (setq en (bpoly pt))
(if (entget en)
(progn
(setq tmp-obj (vlax-ename->vla-object en))
; 获取边界中心
(vla-getboundingbox tmp-obj 'minpoint 'maxpoint)
(setq minpoint (vlax-safearray->list minpoint)
maxpoint (vlax-safearray->list maxpoint))
(setq center-pt (list (* 0.5 (+ (car minpoint) (car maxpoint)))
(* 0.5 (+ (cadr minpoint) (cadr maxpoint)))
0.0))
(entdel en)
)
)
)
)
)
)
(setvar "CMDECHO" oldcmdecho)
center-pt
)
; 获取一组文字的整体边界框
(defun get-group-bounding-box (objs / obj minpoint maxpoint
minX minY maxX maxY first-obj pt-min pt-max)
(if objs
(progn
(setq first-obj (car objs))
(vla-getboundingbox first-obj 'minpoint 'maxpoint)
(setq minX (car (setq pt-min (vlax-safearray->list minpoint)))
minY (cadr pt-min)
maxX (car (setq pt-max (vlax-safearray->list maxpoint)))
maxY (cadr pt-max))
; 遍历其余对象
(foreach obj (cdr objs)
(vla-getboundingbox obj 'minpoint 'maxpoint)
(setq pt-min (vlax-safearray->list minpoint)
pt-max (vlax-safearray->list maxpoint))
(setq minX (min minX (car pt-min))
minY (min minY (cadr pt-min))
maxX (max maxX (car pt-max))
maxY (max maxY (cadr pt-max)))
)
; 返回整体边界框的中心
(list (* 0.5 (+ minX maxX))
(* 0.5 (+ minY maxY))
0.0)
)
nil
)
)
; 选择文字对象（支持天正文字）
(defun select-text-objects (/ ss)
(princ "\n选择需要居中的文字对象：")
; 尝试多种选择方式
(cond
; 方式1：包含天正文字的选择
((setq ss (ssget '((0 . "TEXT,MTEXT,ATTRIB,TCH_TEXT,TCH_MTEXT"))))
(princ (strcat "\n找到 " (itoa (sslength ss)) " 个文字对象（包含天正文字）"))
ss)
; 方式2：只选择普通文字
((setq ss (ssget '((0 . "TEXT,MTEXT,ATTRIB"))))
(princ (strcat "\n找到 " (itoa (sslength ss)) " 个文字对象"))
ss)
; 方式3：使用通用选择
((setq ss (ssget))
(princ "\n提示：请确保选择的是文字对象")
ss)
(t nil)
)
)
(if (setq ss (select-text-objects))
(progn
(setq startTime (getvar "MILLISECS"))
(setq acadDoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark acadDoc)
; 预计算选择集长度
(setq sslen (sslength ss)
count 0
i 0
text-count 0)
; 第一阶段：收集文字对象和它们的中心点
(setq text-centers '())
(while (< i sslen)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
; 检查是否为文字对象（包括天正文字）
(if (is-text-object obj)
(progn
(setq center-pt (get-text-center obj))
(if center-pt
(progn
(setq text-centers (cons (list center-pt obj) text-centers))
(setq text-count (1+ text-count))
)
)
)
(princ (strcat "\n跳过非文字对象: " (vla-get-objectname obj)))
)
(setq i (1+ i))
)
(princ (strcat "\n找到 " (itoa text-count) " 个有效文字对象"))
(if text-centers
(progn
; 第二阶段：获取每个文字对应的边界中心点，并按边界中心点分组
(setq boundary-data '()
groups '()); 分组列表：((文字对象列表 边界中心点) ...)
(foreach tc text-centers
(setq pt0 (car tc)
obj (cadr tc))
; 获取边界中心点
(setq pt1 (get-boundary-center pt0))
; 如果获取边界中心失败，使用文字当前位置
(if (not pt1)
(setq pt1 pt0)
)
; 添加到边界数据列表
(setq boundary-data (cons (list pt0 pt1 obj) boundary-data))
; 按边界中心点分组
(setq found-group nil)
(foreach group groups
(if (and (cadr group)
(equal pt1 (cadr group) 0.001)); 比较边界中心点
(progn
; 添加到现有组
(setq obj-list (car group))
(setq obj-list (cons obj obj-list))
(setq groups (subst (list obj-list pt1) group groups))
(setq found-group t)
)
)
)
; 如果没有找到匹配的组，创建新组
(if (not found-group)
(setq groups (cons (list (list obj) pt1) groups))
)
)
(princ (strcat "\n分组完成，共 " (itoa (length groups)) " 个组"))
; 显示分组信息
(setq group-index 1)
(foreach group groups
(setq group-size (length (car group)))
(if (> group-size 1)
(princ (strcat "\n组 " (itoa group-index) ": " (itoa group-size) " 个文字（将整体移动）"))
)
(setq group-index (1+ group-index))
)
; 第三阶段：按组移动文字
(setq moved-groups 0)
(foreach group groups
(setq obj-list (car group) ; 组内的文字对象列表
target-pt (cadr group)) ; 目标中心点
; 计算组内所有文字的整体中心点
(setq group-center (get-group-bounding-box obj-list))
(if (and group-center target-pt
(not (equal group-center target-pt 0.001)))
(progn
; 计算偏移量
(setq offset-x (- (car target-pt) (car group-center))
offset-y (- (cadr target-pt) (cadr group-center)))
; 移动组内所有文字
(foreach obj obj-list
(setq obj-center (get-text-center obj))
(if obj-center
(progn
(setq new-pt (list (+ (car obj-center) offset-x)
(+ (cadr obj-center) offset-y)
0.0))
(vla-move obj (vlax-3d-point obj-center) (vlax-3d-point new-pt))
(setq count (1+ count))
)
)
)
(if (> (length obj-list) 1)
(setq moved-groups (1+ moved-groups)))
(princ (strcat "\n组移动: " (itoa (length obj-list)) " 个文字移动到边界中心"))
)
(if (> (length obj-list) 1)
(princ (strcat "\n组已居中，跳过: " (itoa (length obj-list)) " 个文字"))
)
)
)
(if (> moved-groups 0)
(princ (strcat "\n\n成功移动 " (itoa moved-groups) " 个文字组"))
)
)
(princ "\n未找到有效的文字对象！")
)
(vla-endundomark acadDoc)
; 显示处理时间
(setq elapsed (- (getvar "MILLISECS") startTime))
(if (> elapsed 0)
(princ (strcat "\n\n操作完成，共移动 " (itoa count) " 个文字对象"
"\n处理总数: " (itoa text-count) "，耗时 "
(rtos (/ elapsed 1000.0) 2 3) " 秒"))
(princ (strcat "\n\n操作完成，共移动 " (itoa count) " 个文字对象"))
)
)
(princ "\n没有选择文字对象！")
)
; 恢复系统变量
(setvar "REGENMODE" oldregenmode)
(setvar "DRAGMODE" 2)
(setvar "BLIPMODE" oldblipmode)
(setvar "HIGHLIGHT" 1)
(setvar "OSMODE" oldosmode)
(setvar "CMDECHO" 1)
; 最后进行一次重生成（如果需要）
(if (and (> count 0) (= oldregenmode 1))
(command "_.REGEN")
)
; 强制垃圾回收
(gc)
(princ)
)
;;; 增强版：显示天正文字详细信息
(defun C:dda-tz (/ ss i ent obj obj-type)
(setvar "CMDECHO" 0)
(vl-load-com)
(princ "\n选择需要分析的文字对象（包括天正文字）：")
(if (setq ss (ssget))
(progn
(setq total (sslength ss)
i 0
tch-count 0
normal-count 0)
(princ (strcat "\n分析 " (itoa total) " 个对象...\n"))
; 分析每个对象的类型
(while (< i total)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(setq obj-type (vla-get-objectname obj))
(princ (strcat "对象 " (itoa (1+ i)) ": " obj-type))
; 判断是否为天正文字
(if (wcmatch (strcase obj-type) "*TCH_*")
(progn
(princ " (天正对象)")
(setq tch-count (1+ tch-count))
; 显示天正文字的属性
(if (vlax-property-available-p obj 'TextString)
(princ (strcat " 内容: \"" (vla-get-TextString obj) "\""))
)
(if (vlax-property-available-p obj 'InsertionPoint)
(progn
(setq ins-pt (vlax-safearray->list
(vlax-variant-value
(vla-get-InsertionPoint obj))))
(princ (strcat " 位置: (" (rtos (car ins-pt) 2 2) ", "
(rtos (cadr ins-pt) 2 2) ")"))
)
)
)
; 判断是否为普通文字
(if (wcmatch (strcase obj-type) "*TEXT*,*MTEXT*,*ATTRIB*")
(progn
(princ " (普通文字)")
(setq normal-count (1+ normal-count))
)
(princ " (非文字对象)")
)
)
(princ "\n")
(setq i (1+ i))
)
(princ (strcat "\n统计结果:"
"\n天正文字对象: " (itoa tch-count)
"\n普通文字对象: " (itoa normal-count)
"\n其他对象: " (itoa (- total tch-count normal-count))
"\n总计: " (itoa total)))
)
(princ "\n未选择对象！")
)
(setvar "CMDECHO" 1)
(princ)
)
本帖最后由 tryhi 于 2025-12-5 15:14 编辑
挺好的，提2个建议，
1、变量修改建议在ssget之后，否则如果*error*没触发（调试环境下）会导致使用后变量没有成功恢复，导致用完之后move跟copy命令无预览
2、同个单元格如果两个文本会重叠在一起 本帖最后由 szhorse 于 2025-12-5 23:24 编辑
测试了一下，我电脑出错没跑起来
发个图上来，大家一起测试一下。图中列举了几种情况
手机上不能直接传dwg，压缩了一下
很好，这次不用开盲盒。纯支持了~ 罕见的没收费系列 本帖最后由 zhoupeng220 于 2025-12-5 15:09 编辑
源码,支持一波。 感谢分享，辛苦了 感谢分享，！！！ 不会使用 不知道使用场景
试用了一下，报错，语法错误和有缺陷
页:
[1]
2