求助：自动获取图框的两个角点（图框为块）

刘炎华

卡在这里了，请大家帮助...
(defun C:tt ( / k ss )
(setq k (cdr (assoc 1 (entget (car (nentsel "\nselect source text:"))))))
;这里怎样得到图块"A4"的两个角点pt1,pt2呢？
(setq ss (ssget "x" (list '(0 . "TEXT,MTEXT")
    (cons 1 (strcat  k ))
  '(-4 . "<and")
   '(-4 . ">,>,*") (cons 10 pt1)
   '(-4 . "<,<,*") (cons 10 pt2)
  '(-4 . "and>"))))
(sssetfirst nil ss)
(princ (strcat "\n共选中了" (itoa (sslength ss)) " 个对象\n"))(princ))

yshf

(defun C:tt ( / k ss )
    (vl-load-com)
    (if (progn
            (princ "\n请选取A4图块:")
            (setq Kss (ssget ":S" '((0 . "insert"))))
        )
        (progn
            (setq Kobj (vlax-ename->vla-object (ssname Kss 0)))
            ;取得块最小外包矩形左下角点和右上角点
            (vla-GetBoundingBox Kobj 'Pmin 'Pmax)
            (setq pt1 (vlax-safearray->list Pmin))
            (setq pt2 (vlax-safearray->list Pmax))
            (if (setq ss (ssget "w" pt1 pt2 '((0 . "*text"))))
                (progn
                    (sssetfirst nil ss)
                    (princ (strcat "\n共选中了" (itoa (sslength ss)) " 个对象\n"))
                )
            )
        )
    )
    (princ)
)

Bao_lai

关键字搜索 包围盒 vla-GetBoundingBox

刘炎华

Bao_lai 发表于 2021-8-1 03:47
关键字搜索 包围盒 vla-GetBoundingBox

大师：接下来要怎么弄呢？
(defun C:tt ( / k ss ss1)
(setq k (cdr (assoc 1 (entget (car (nentsel "\nselect source text:"))))))
这里怎么得到en呢？
(xv:ssmid en)
(setq ss (ssget "x" (list '(0 . "TEXT,MTEXT")
    (cons 1 (strcat  k ))
  '(-4 . "<and")
   '(-4 . ">,>,*") (cons 10 pt1)
   '(-4 . "<,<,*") (cons 10 pt2)
  '(-4 . "and>"))))
(sssetfirst nil ss)
(princ (strcat "\n共选中了" (itoa (sslength ss)) " 个对象\n"))(princ))

;;选择集中心点函数 by xvjiex
(defun xv:ssmid (ss / i1 plst ent xmin xmax ymin ymax pmin pmax)
(setq i1 -1 plst nil)
(while (setq ent (ssname ss (setq i1 (1+ i1))))
  (setq plst (append (ebox ent) plst))
)
(setq plst (vl-sort plst '(lambda (x y) (< (car x) (car y)))))
(setq xmin (car(nth 0 plst)) xmax (car(nth (-(length plst)1)plst)))
(setq plst (vl-sort plst '(lambda (x y) (< (cadr x) (cadr y)))))
(setq ymin (cadr(nth 0 plst)) ymax (cadr(nth (-(length plst)1)plst)))
(setq pt1 (list xmin ymin 0.) pt2 (list xmax ymax 0.))
)
(defun ebox (e / pa pb)
(Vlax-Invoke-Method (Vlax-Ename->Vla-Object e ) 'GetBoundingBox 'pa 'pb )
(setq pa (trans (vlax-safearray->list pa) 0 1)
  pb (trans (vlax-safearray->list pb) 0 1)
)
(list pa pb)
)

刘炎华

yshf 发表于 2021-8-1 11:35
(defun C:tt ( / k ss )
    (vl-load-com)
    (if (progn

长老您好！
程序功能是加工注解的检查：
是我选了目标文字后，会自动找到目标文字所在图框内相同的文字作为一个选择集。
如图片：选取文字是用户指定 结果：仅图框内的相同字被选中（图档内其它位置的不选中）

tigcat

刘炎华 发表于 2021-8-1 12:53
长老您好！
程序功能是加工注解的检查：
是我选了目标文字后，会自动找到目标文字所在图框内相同的文字 ...

;作者yshf,加点补充
(defun C:tt ( / k ss )
    (vl-load-com)
    (if (progn
            (princ "\n请选取A4图块:")
            (setq k        (cdr          (assoc 1 (entget (car (nentsel "\nselect source text:"))))))
            (setq Kss (ssget ":S" '((0 . "insert"))))
        )
        (progn
            (setq Kobj (vlax-ename->vla-object (ssname Kss 0)))
            ;取得块最小外包矩形左下角点和右上角点
            (vla-GetBoundingBox Kobj 'Pmin 'Pmax)
            (setq pt1 (vlax-safearray->list Pmin))
            (setq pt2 (vlax-safearray->list Pmax))
            (if (setq ss (ssget "w" pt1 pt2 (list (cons 0  "*text")(cons 1 k))))
                (progn
                    (sssetfirst nil ss)
                    (princ (strcat "\n共选中了" (itoa (sslength ss)) " 个对象\n"))
                )
            )
        )
    )
    (princ)
)

刘炎华

tigcat 发表于 2021-8-1 16:08
;作者yshf,加点补充
(defun C:tt ( / k ss )
    (vl-load-com)

谢谢！
结果是这个，但是多了个选图块的动作。注解是很多行的，所以想把这个动作优化掉，让程序实现。

qijun0818

是想要选择图框内的文字吗?

海盗曹

mark一下，以备学习

LPACMQ

海盗曹 发表于 2021-8-3 16:09
mark一下，以备学习

你是论坛混迹十年的元老了