查找多层嵌套块内文本对象，并正确绘制圆形标记
主要目的在于检索当前dwg文件中的某些字符，并在其上绘制圆形便于查看标记。目前我能成功在单行文本、多行文本、以及单层块内实现这个目的，但是无法在多层嵌套块中正确位置绘制圆形。而且每次多层嵌套块绘制出来的圆形都在图纸原点，我很q
(defun c:DrawCircleAtBlockText (/ *error* main acadDoc blks str dia)
(vl-load-com)
(setq foundCount 0); 设置计数器为全局变量
;; 错误处理函数
(defun *error* (msg)
(if acadDoc (vla-EndUndoMark acadDoc))
(princ (strcat "\n 错误: " msg))
(princ)
)
;; 创建或获取图层
(defun setup-layer (layerName colorIndex / layerObj layers)
(setq layers (vla-get-Layers
(vla-get-ActiveDocument
(vlax-get-acad-object))))
;; 尝试获取已存在的图层
(if (not (vl-catch-all-error-p
(setq layerObj (vl-catch-all-apply 'vla-item
(list layers layerName)))))
layerObj
;; 如果图层不存在，创建新图层
(setq layerObj (vla-add layers layerName))
)
;; 设置图层颜色
(vla-put-Color layerObj colorIndex)
layerName
)
;; 计算总块数
(defun count-total-blocks (blks / count)
(setq count 0)
(vlax-for blk blks
(setq count (1+ count))
)
count
)
;; 更新进度条
(defun update-progress (current total / percent)
(setq percent (fix (* (/ current total) 100.0)))
(princ (strcat "\r处理进度: " (itoa percent) "%"))
(if (= current total) (princ "\n"))
)
;; 主处理函数
(defun main ()
(setq acadDoc (vla-get-ActiveDocument (vlax-get-acad-object))
blks (vla-get-Blocks acadDoc))
;; 处理图层
(setup-layer "M-0-E" 6)
;; 获取并验证文字输入
(while (not str)
(setq str (getstring "\n请输入需要查找的文字内容: "))
(cond
((= str "")
(setq str nil)
(princ "\n 错误: 文字内容不能为空，请重新输入")
)
((= str nil)
(exit)
)
)
)
;; 获取并验证直径输入
(while (not dia)
(setq dia (getdist "\n请输入圆形直径: "))
(cond
((and dia (<= dia 0.0))
(setq dia nil)
(princ "\n 错误: 直径必须大于0，请重新输入")
)
((= dia nil)
(exit)
)
)
)
(vla-StartUndoMark acadDoc)
(if (and str dia)
(progn
(setq totalBlocks (count-total-blocks blks)
currentBlock 0)
(princ "\n 开始处理，总块数: ")
(princ totalBlocks)
(vlax-for blkDef blks
(setq currentBlock (1+ currentBlock))
(update-progress currentBlock totalBlocks)
(process-block-def blkDef str dia)
)
(princ (strcat "\n 已成功创建 " (itoa foundCount) " 个圆形"))
)
(princ "\n 操作已取消")
)
(vla-EndUndoMark acadDoc)
)
;; 块定义处理
(defun process-block-def (blkDef str dia / found)
(princ (strcat "\n 正在处理块定义: " (vla-get-Name blkDef)))
;; 首先处理普通文本对象
(vlax-for obj blkDef
(cond
((or (= (vla-get-ObjectName obj) "AcDbText")
(= (vla-get-ObjectName obj) "AcDbMText"))
(princ (strcat "\n 找到文本对象，内容: " (vla-get-TextString obj)))
(if (= (strcase (vla-get-TextString obj)) (strcase str))
(progn
(princ "\n 文本内容匹配成功")
(create-circle-at-text obj dia)
(setq found t)
)
))
;; 处理块参照
((= (vla-get-ObjectName obj) "AcDbBlockReference")
(princ "\n 找到块参照")
(if (process-block-reference obj str dia)
(setq found t)
))
)
)
found
)
;; 在普通文本位置创建圆
(defun create-circle-at-text (textObj dia / textPt)
(setq textPt (vlax-get textObj 'InsertionPoint))
(princ (strcat "\n 文本坐标: " (vl-princ-to-string textPt)))
(if (entmakex
(list
'(0 . "CIRCLE")
'(8 . "M-0-E")
(cons 10 textPt)
(cons 40 (/ dia 2.0))
)
)
(progn
(setq foundCount (1+ foundCount))
(princ "\n 创建圆形成功"))
(princ "\n 创建圆形失败"))
)
;; 处理块参照中的文本
(defun process-block-reference (blkRef str dia / blkDef found)
(if (setq blkDef (vla-item blks (vla-get-Name blkRef)))
(progn
(princ (strcat "\n 处理块参照: " (vla-get-Name blkRef)))
(vlax-for obj blkDef
(cond
;; 处理块中的文本
((or (= (vla-get-ObjectName obj) "AcDbText")
(= (vla-get-ObjectName obj) "AcDbMText"))
(princ (strcat "\n 块中找到文本，内容: " (vla-get-TextString obj)))
(if (= (strcase (vla-get-TextString obj)) (strcase str))
(progn
(princ "\n 块中文本匹配成功")
(create-circle-at-block-text obj blkRef dia)
(setq found t)
)
))
;; 处理嵌套块
((= (vla-get-ObjectName obj) "AcDbBlockReference")
(if (process-block-reference obj str dia)
(setq found t)
))
)
)
)
)
found
)
;; 在块参照中的文本位置创建圆
(defun create-circle-at-block-text (textObj blkRef dia / textPt mat worldPt)
(setq textPt (vlax-get textObj 'InsertionPoint))
(princ (strcat "\n 块中文本局部坐标: " (vl-princ-to-string textPt)))
;; 获取块的变换矩阵
(setq mat (get-cumulative-matrix blkRef))
(setq worldPt (apply-matrix textPt mat))
(princ (strcat "\n 转换后的世界坐标: " (vl-princ-to-string worldPt)))
(if (entmakex
(list
'(0 . "CIRCLE")
'(8 . "M-0-E")
(cons 10 worldPt)
(cons 40 (/ dia 2.0))
)
)
(progn
(setq foundCount (1+ foundCount))
(princ "\n 创建圆形成功"))
(princ "\n 创建圆形失败"))
)
;; 实例处理（用于块参照中的文本对象）
;; 将未使用的函数转换为注释
;; ===== 以下为未使用的函数，已注释 =====
;; process-block-instances 函数定义
#|
(defun process-block-instances (blkDef textObj dia / ss refID mat textPtWorld)
(princ (strcat "\n 处理块实例: " (vla-get-Name blkDef)))
;; 获取文本在块定义中的局部坐标
(setq textPt (vlax-get textObj 'InsertionPoint))
(princ (strcat "\n 文本局部坐标: " (vl-princ-to-string textPt)))
;; 处理所有块实例
(setq blkName (vla-get-Name blkDef)
ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blkName))))
(if ss
(progn
(princ (strcat "\n 找到 " (itoa (sslength ss)) " 个块实例"))
(repeat (setq cnt (sslength ss))
(setq refID (ssname ss (setq cnt (1- cnt))))
;; 转换为VLA对象并应用变换
(if (setq refID (vlax-ename->vla-object refID))
(progn
(setq mat (get-cumulative-matrix refID))
(setq textPtWorld (apply-matrix textPt mat))
(princ (strcat "\n 转换后的世界坐标: " (vl-princ-to-string textPtWorld)))
;; 创建圆
(if (entmakex
(list
'(0 . "CIRCLE")
'(8 . "M-0-E")
(cons 10 textPtWorld)
(cons 40 (/ dia 2.0))
)
)
(progn
(setq foundCount (1+ foundCount))
(princ "\n 创建圆形成功"))
(princ "\n 创建圆形失败"))
)
)
)
)
(princ "\n 未找到块实例")
)
)
|#
;; 获取累积变换矩阵（递归处理嵌套块）
(defun get-cumulative-matrix (blkRef / parentMatrix parentEnt)
(setq parentMatrix (get-block-transform blkRef))
;; 获取当前块参照的所有者（父块）
(if (and blkRef
(setq parentEnt (vlax-vla-object->ename blkRef))
(setq parentEnt (entnext parentEnt))
(= "INSERT" (cdr (assoc 0 (entget parentEnt)))))
;; 如果还在嵌套块中，继续向上递归
(if (setq parentObj (vlax-ename->vla-object parentEnt))
(setq parentMatrix (multiply-matrices
(get-cumulative-matrix parentObj)
parentMatrix))
)
)
parentMatrix
)
;; 获取单个块的变换矩阵（平移、旋转、缩放）
(defun get-block-transform (blkRef / insPt scaleX scaleY rotAng mat)
(setq insPt(vlax-get blkRef 'InsertionPoint)
scaleX (vla-get-XScaleFactor blkRef)
scaleY (vla-get-YScaleFactor blkRef)
rotAng (vla-get-Rotation blkRef))
;; 构建变换矩阵（4x4齐次矩阵）
(setq mat (list
(list (* scaleX (cos rotAng)) (* (- scaleY) (sin rotAng)) 0.0 (car insPt))
(list (* scaleX (sin rotAng)) (* scaleY (cos rotAng)) 0.0 (cadr insPt))
(list 0.0 0.0 1.0 (if (caddr insPt) (caddr insPt) 0.0))
(list 0.0 0.0 0.0 1.0)))
mat
)
;; 矩阵乘法（合并嵌套变换）
(defun multiply-matrices (mat1 mat2 / result)
(setq result (mapcar '(lambda (row)
(mapcar '(lambda (col)
(apply '+ (mapcar '* row col)))
(apply 'mapcar (cons 'list mat2))))
mat1))
result
)
;; 应用矩阵变换到点
(defun apply-matrix (pt mat / x y z)
(setq x (car pt)
y (cadr pt)
z (caddr pt))
(list
(+ (* x (caar mat)) (* y (cadar mat)) (* z (caddar mat)) (cadddr (car mat)))
(+ (* x (caadr mat)) (* y (cadadr mat)) (* z (caddr (cadr mat))) (cadddr (cadr mat)))
(+ (* x (caaddr mat)) (* y (cadadr mat)) (* z (caddr (caddr mat))) (cadddr (caddr mat))))
)
#|
;; 增强嵌套块处理（递归遍历所有层级）
(defun process-nested-block (blkDef str dia / obj)
(vlax-for obj blkDef
(cond
((= (vla-get-ObjectName obj) "AcDbBlockReference")
(process-block-def
(vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-get-Name obj))
str dia)
)
)
)
)
|#
(main)
(princ)
)
本帖最后由 ssyfeng 于 2025-3-1 11:08 编辑
转换一下坐标应该就可以
嵌套块要不停地计算嵌套矩阵再转换。比较简单的方式是将图块弄到DBX中，逐层分解到没有图块，然后过滤全图找到需要标记的文本，再根据文本位置在DWG中创建圆。 ssyfeng 发表于 2025-2-28 11:42
转换一下坐标应该就可以
我试了坐标转换，单层块没问题 多层嵌套块坐标转换画出来的圆形还是不在其位，会偏离，昨天弄了半天也没有解决。 kozmosovia 发表于 2025-2-28 11:44
嵌套块要不停地计算嵌套矩阵再转换。比较简单的方式是将图块弄到DBX中，逐层分解到没有图块，然后过滤全图 ...
哎，这不是我想要的结果，会破坏原图的完整性。但这确实是最简单的做法。 jezli 发表于 2025-2-28 14:29
哎，这不是我想要的结果，会破坏原图的完整性。但这确实是最简单的做法。
不需要破坏DWG，explode是在DBX中进行的，对DWG没有任何影响 楼主搞得过于复杂,实际上不存在嵌套块的处理
帮你修改了一下
(defun c:DrawCircleAtBlockText (/ ACADDOC BLKS
CIRCLE DIA FOUNDCOUNT
STR TEXTPT TOTALBLOCKS
*error* process-block-def
)
(vl-load-com)
;; 错误处理函数
(defun *error* (msg)
(ifacadDoc
(vla-EndUndoMark acadDoc)
)
(princ (strcat "\n 错误: " msg))
(princ)
)
;; 块定义处理
(defun process-block-def (blkDef str dia / found)
(setq found 0)
(vlax-for obj blkDef
(if (and (or (= (vla-get-ObjectName obj) "AcDbText")
(= (vla-get-ObjectName obj) "AcDbMText")
)
(= (strcase (vla-get-TextString obj)) (strcase str))
)
(progn
(setq found (1+ found))
(setq textPt (vla-get-InsertionPoint obj))
(setq circle (vla-addcircle blkDef textPt (* dia 0.5)))
(vla-put-layer circle "M-0-E")
)
)
)
found
)
(setq foundCount 0) ; 设置计数器为全局变量
(setqacadDoc(vla-get-ActiveDocument (vlax-get-acad-object))
blks(vla-get-Blocks acadDoc)
)
;; 处理图层
(if (not (tblsearch "layer" "M-0-E"))
(entmake '((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(70 . 0)
(6 . "Continuous")
(2 . "M-0-E")
(62 . 6)
)
)
)
;; 获取并验证文字输入
(while (= (setq str (getstring "\n请输入需要查找的文字内容: ")) "")
(princ "\n 错误: 文字内容不能为空，请重新输入")
)
;; 获取并验证直径输入
(while (<= (setq dia (getdist "\n请输入圆形直径: ")) 0.0)
(princ "\n 错误: 直径必须大于0，请重新输入")
)
(vla-StartUndoMark acadDoc)
(setq totalBlocks (vla-get-count blks))
(acet-ui-progress "开始处理..." totalBlocks)
(vlax-for blkDef blks
(acet-ui-progress -1)
(setq foundCount
(+ foundCount (process-block-def blkDef str dia))
)
)
(acet-ui-progress)
(princ
(strcat "\n 已成功创建 " (itoa foundCount) " 个圆形")
)
(vla-EndUndoMark acadDoc)
(vla-Regen acadDoc acActiveViewport)
(princ)
)
xyp1964 发表于 2025-2-27 18:36
求大佬赐教 点播
页:
[1]