怎样获取这种图块的最小点与最大点
如图所示，我选择左上角的图框块，获取最小点与最大点，画出红色的框线，但这并不是我想要的，我想要的是左下角的效果。然后我把这个图框打散，发现问题所在。这是因为图框中的多行文字造成的。问题是，选择这样的图框，怎样避开块中的文字影响，达到左下角的效果？
附上我获得最小点与最大点的代码
(defun c:11(/ ss1 ss2 ss i pmin name pmax minx miny maxx maxy minx0 miny0 maxx0 maxy0 pma pmi)
(setq minx0 1e6miny0 1e6 maxx0 -1e6maxy0 -1e6)
(setq ss1 (cadr (ssgetfirst)))
(if (null ss1)(setq ss2 (ssget ":s")))
(if ss1 (setq ss ss1)(setq ss ss2))
(repeat (setq i (sslength ss))
(setq name (ssname ss (setq i (1- i))))
(vla-getboundingbox (vlax-ename->vla-object name) 'minpoint 'maxpoint)
(setq pmax (vlax-safearray->list maxpoint)pmin (vlax-safearray->list minpoint))
(setq minx (car pmin)maxx (car pmax)miny (cadr pmin)maxy (cadr pmax))
(if (> minx0 minx) (setq minx0 minx))
(if (> miny0 miny) (setq miny0 miny))
(if (< maxx0 maxx) (setq maxx0 maxx))
(if (< maxy0 maxy) (setq maxy0 maxy))
)
(setq pmi (list minx0 miny0 0.0));;最小点
(setq pma (list maxx0 maxy0 0.0));;最大点
(if ss2 (vl-cmdf "rectang" "non" pmi "non" pma) )
(princ)
)
(defun c:tt (/ dxm ss1 ss2)
(setq dxm (car (entsel "\n选择目标对象:")));获取对象名
(command "_.copy" dxm "" "0,0" "@");原地复制对象
(command "EXPLODE" (entlast));炸开对象
(setq ss1 (ssget "p" ));炸开后的所有对象
(setq ss2 (ssget "p" '((0 . "LINE,LWPOLYLINE"))));不包括文字的对象
(get-dxj5d ss2);获取对象集的 5点
(command "ERASE" ss1 "")
(command "ERASE" ss2 "")
)
参考一下这个 ;;说明:获得块包围盒排除属性块及文字的干扰
;;参数:BLK:obj对象
;;返回:块两点包围盒(不一定是左下右上点)
(defun lm-get-blkboundingbox (blk / bnm lst llp urp)
(defun refgeom (ent / ang ang mat ocs)
(setq enx (entget ent))
(setq ang (cdr (assoc 50 enx)))
(setq ocs (cdr (assoc 210 enx)))
(list (setq
mat (mxm (mapcar '(lambda (v) (trans v 0 ocs t))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(mxm (list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list (list (cdr (assoc 41 enx)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 enx)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 enx)))
)
)
)
)
(mapcar
'-
(trans (cdr (assoc 10 enx)) ocs 0)
(mxv mat
(cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))
)
)
)
)
(defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v)))
m
)
)
(defun trp (m) (apply 'mapcar (cons 'list m)))
(defun mxm (m n)
((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n))
)
(setq acaddoc (vla-get-activedocument (vlax-get-acad-object)))
(setq bnm (strcase (vla-get-name blk)))
(cond
((setq lst (cdr (assoc bnm lm:blockboundingbox))))
(t
(vlax-for obj (vla-item (vla-get-blocks acaddoc) bnm)
(cond
((and
(= :vlax-true (vla-get-Visible OBJ))
(= "AcDbBlockReference" (vla-get-objectname obj))
)
(setq lst (append lst (lm-get-blkboundingbox obj)))
)
((and
(= :vlax-true (vla-get-visible obj))
(not (wcmatch (vla-get-objectname obj) "AcDbAttributeDefinition,AcDb*Text,TDb*Text"))
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox(list obj 'llp 'urp))))
)
(setq lst (vl-list* (vlax-safearray->list llp)(vlax-safearray->list urp)lst))
)
)
)
)
)
(cond
(lst
(setq lst (mapcar'(lambda (fun) (apply 'mapcar (cons fun lst)))'(min max)))
(setq lm:blockboundingbox (cons (cons bnm lst) lm:blockboundingbox))
)
)
(apply '(lambda (m v) (mapcar '(lambda (p) (mapcar '+ (mxv m p) v)) lst))(refgeom (vlax-vla-object->ename blk)))
) 本帖最后由 自贡黄明儒 于 2024-8-13 15:14 编辑
重定义块，文字基点不要搞那么远，直接
(vla-getboundingbox (vlax-ename->vla-object name) 'minpoint 'maxpoint)
(defun t1t1t1 (e / A B EB EN L NAME OBJ)
(setq en (entget e))
(setq name (cdr (assoc 2 en)))
(setq eb (TBLOBJNAME "Block" name))
(while (setq eb (entnext eb))
;;如果不是*TEXT,ATTDEF ,求包围盒
(setq name (cdr (assoc 0 (entget eb))))
(if(not (wcmatch name "*TEXT,ATTDEF"))
(progn
(setq obj (vlax-ename->vla-object eb))
(vla-GetBoundingBox obj 'a 'b)
(setq a (safearray-value a))
(setq b (safearray-value b))
(setq L (cons a L))
(setq L (cons b L))
)
)
)
;;如果L存在，求包围盒
(if L
(list
(apply 'mapcar (cons 'min L))
(apply 'mapcar (cons 'max L))
)
)
)
;;选择块
(defun C:t1 (/ A B E L OBJ)
(setq e (car (entsel)))
;;此块的外围盒
(setq obj (vlax-ename->vla-object e))
(vla-GetBoundingBox obj 'a 'b)
(setq a (safearray-value a))
(setq b (safearray-value b))
(setq L (cons a L))
(setq L (cons b L))
(princ (list
(apply 'mapcar (cons 'min L))
(apply 'mapcar (cons 'max L))
)
)
;;块最小包围盒
(princ (t1t1t1 e))
(princ)
)
克隆一下块，删除里面的文本，求包围盒 自贡黄明儒 发表于 2024-8-5 14:03
重定义块，文字基点不要搞那么远，直接
(vla-getboundingbox (vlax-ename->vla-object name) 'minpoint 'm ...
有时候并不是选择一个图块，会同时选择多个图块的 本帖最后由 天命 于 2024-8-5 14:31 编辑
多行文字的边界太远了吧,把多行文字过滤掉
这个我见过啊，之前有个也是说的这个，院长说是多行字框出去了 统一网名 发表于 2024-8-5 16:37
(defun c:tt (/ dxm ss1 ss2)
(setq dxm (car (entsel "\n选择目标对象:")));获取对象名
(command "_.c ...
简单粗暴有效
不过重块的还再炸才可以。 本帖最后由 null. 于 2024-8-13 13:04 编辑
把块定义的图元找到，排除全部文字图元后，生成一个基于这个块定义位置的矩形框A后，取得这个块的矩阵，传导给矩形框A后，就得到你想要这个位置的矩形框。
这个方法还可以扩展到其他功能，根据选择块定义的中不同定义的图元，生成A图元后，再通过块的矩阵传导，块内的定点插入图元。
好吧，就是7楼写的，完全是这么干的。也不是，这个程序不用生成矩形框A，只取得基于块定义位置的最大和最小点，直接把块矩阵mat传导给这两个点。我还不会这个。
页:
[1]
2