如何得到文字的包围框坐标？

Faster

求助高手：如何得到如下测试文件中的文字的包围框坐标？

测试文件:

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:text.rar 
下载次数:14  文件大小:16.52 KB 
下载权限: 不限 以上  [免费赚D豆]

XDSoft

前两天刚讨论的获得UCS下包围盒的方法，去看看下面的帖子有需要的没。

http://bbs.xdcad.net/forum.php?mod=viewthread&tid=667642

Underway

(acet-geom-textbox (entget ENT) 0))  ; Use ET 函数

Free-Lancer

贴一段 Autolisp Help中的 Textbox解释

The textbox function returns the diagonal coordinates of a box that encloses a text object. It takes an entity definition list of the type returned by entget (an association list of group codes and values) as its single argument. This list can contain a complete association list description of the text object or just a list describing the text string.

The points returned by textbox describe the bounding box (an imaginary box that encloses the text object) of the text object, as if its insertion point were located at (0,0,0) and its rotation angle were 0. The first list returned is the point (0.0 0.0 0.0), unless the text object is oblique or vertical or it contains letters with descenders (such as g and p). The value of the first point list specifies the offset distance from the text insertion point to the lower-left corner of the smallest rectangle enclosing the text. The second point list specifies the upper-right corner of that box. The returned point lists always describe the bottom-left and upper-right corners of this bounding box, regardless of the orientation of the text being measured.

The following example shows the minimum allowable entity definition list that textbox accepts. Because no additional information is provided, textbox uses the current defaults for text style and height.

Command:  (textbox '((1 . "Hello world")) )

((0.0 0.0 0.0) (2.80952 1.0 0.0))

The actual values returned by textbox will vary depending on the current text style.

The following example demonstrates one method of providing the textbox function with an entity definition list.

Command:  dtext

Justify/Style/<Start point>:  1,1

Height <1.0000>:  ENTER

Rotation angle <0>:  ENTER

Text:  test

Text:  ENTER

Command:  (setq e (entget (entlast)))

((-1 . <Entity name: 1ba3568>) (0 . "TEXT") (330 . <Entity name: 1ba34f8>) (5 .

"2D") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 .

"AcDbText") (10 1.0 1.0 0.0) (40 . 1.0) (1 . "test") (50 . 0.0) (41 . 1.0) (51

. 0.0) (7 . "Standard") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0)

(100 . "AcDbText") (73 . 0))

Command:  (textbox e)

((0.0 0.0 0.0) (0.8 0.2 0.0))

The following figure shows the results of applying textbox to a text object with a height of 1.0. The figure also shows the baseline and insertion point of the text.



If the text is vertical or rotated, pt1 is still the bottom-left corner and pt2 is the upper-right corner; the bottom-left point may have negative offsets if necessary.

The following figure shows the point values (pt1 and pt2) that textbox returns for samples of vertical and aligned text. In both samples, the height of the letters is 1.0. (For the aligned text, the height is adjusted to fit the alignment points.)



When using vertical text styles, the points are still returned in left-to-right, bottom-to-top order as they are for horizontal styles, so that the first point list will contain negative offsets from the text insertion point.



Regardless of the text orientation or style, the points returned by textbox are such that the text insertion point (group code 10) directly translates to the origin point of the object coordinate system (OCS) for the associated text object. This point can be referenced when translating the coordinates returned from textbox into points that define the actual extent of the text. The two sample routines that follow use textbox to place a box around selected text regardless of its orientation.
[pcode=lisp,true]
(defun C:TBOX ( / textent tb ll ur ul lr)
  (setq textent (car (entsel "\nSelect text: ")))
  (command "ucs" "Object" textent)
  (setq tb (textbox (list  (cons -1 textent)))
        ll (car tb)
        ur  (cadr tb)
        ul  (list (car ll) (cadr ur))
        lr (list (car ur) (cadr ll))
  )
  (command "pline" ll lr ur ul "Close")
  (command "ucs" "p")
  (princ)
)
The second routine, which follows, accomplishes the same task as the first routine by performing the geometric calculations with the sin and cos AutoLISP functions. The result is correct only if the current UCS is parallel to the plane of the text object.

(defun C:TBOX2 ( / textent ang sinrot cosrot
                   t1 t2 p0 p1 p2 p3 p4)
  (setq textent (entget (car (entsel "\nSelect text: "))))
  (setq p0 (cdr (assoc 10 textent))
        ang (cdr (assoc 50 textent))
        sinrot (sin ang)
        cosrot (cos ang)
        t1 (car (textbox textent))
        t2 (cadr (textbox textent))
        p1 (list
          (+ (car p0)
            (- (* (car t1) cosrot)(* (cadr t1) sinrot))
          )
          (+ (cadr p0)
            (+ (* (car t1) sinrot)(* (cadr t1) cosrot))
          )
      )
      p2 (list
        (+ (car p0)
          (- (* (car t2) cosrot)(* (cadr t1) sinrot))
        )
        (+ (cadr p0)
          (+ (* (car t2) sinrot)(* (cadr t1) cosrot))
        )
      )
      p3 (list
        (+ (car p0)
          (- (* (car t2) cosrot)(* (cadr t2) sinrot))
        )
        (+ (cadr p0)
          (+ (* (car t2) sinrot)(* (cadr t2) cosrot))
        )
      )
      p4 (list
        (+ (car p0)
          (- (* (car t1) cosrot)(* (cadr t2) sinrot))
        )
        (+ (cadr p0)
          (+ (* (car t1) sinrot)(* (cadr t2) cosrot))
        )
      )
  )
  (command "pline" p1 p2 p3 p4 "c")
  (princ)
)
[/pcode]

xshrimp

参考
http://lee-mac.com/assoctextbox.html

                               
登录/注册后可看大图

http://lee-mac.com/boxtext.html

                               
登录/注册后可看大图

Lispboy

本想进来回帖，没想到楼上的恢复都精彩啊，又学到新知识了。

帮忙贴下5楼朋友提供信息的程序。

Faster

Free-Lancer 发表于 2013-5-2 09:10

                               
登录/注册后可看大图

贴一段 Autolisp Help中的 Textbox解释

The textbox function returns the diagonal coordinates of a b ...

tbox2函数在210不为'(0 0 1)的情况下不能得到正确结果！

Lispboy

Faster 发表于 2013-5-2 12:24

                               
登录/注册后可看大图

tbox2函数在210不为'(0 0 1)的情况下不能得到正确结果！

那你试试3楼朋友的 ET的函数可以吗？

Faster

谢谢楼上的各位，参考LeeMac的代码，计算Text/Mtext包围框的函数如下：
[pcode=lisp,true];;;(getTextBox ename) 返回Text、 MText的左下角点 右下角点 右上角点 左上角点
;;改编自Lee Mac http://lee-mac.com/assoctextbox.html
(defun getTextBox (EN / ENX L B R N W H J O)
  (setq enx (entget en))
  (setq        l
         (cond
           ((= "TEXT" (cdr (assoc 0 enx)))
            (setq b (cdr (assoc 10 enx))
                  r (cdr (assoc 50 enx))
                  l (textbox enx)
                  n (cdr (assoc 210 enx))
            )
            (list
              (list (caar l) (cadar l))
              (list (caadr l) (cadar l))
              (list (caadr l) (cadadr l))
              (list (caar l) (cadadr l))
            )
           )
           ((= "MTEXT" (cdr (assoc 0 enx)))
            (setq n (cdr (assoc 210 enx))
                  b (trans (cdr (assoc 10 enx)) 0 n)
                  r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
                  w (cdr (assoc 42 enx))
                  h (cdr (assoc 43 enx))
                  j (cdr (assoc 71 enx))
                  o (list
                      (cond
                        ((member j '(2 5 8)) (/ w -2.0))
                        ((member j '(3 6 9)) (- w))
                        (0.0)
                      )
                      (cond
                        ((member j '(1 2 3)) (- h))
                        ((member j '(4 5 6)) (/ h -2.0))
                        (0.0)
                      )
                    )
            )
            (list
              (list (car o) (cadr o))
              (list (+ (car o) w) (cadr o))
              (list (+ (car o) w) (+ (cadr o) h))
              (list (car o) (+ (cadr o) h))
            )
           )
         )
  )
  (setq        l
         (
          (lambda (m)
            (mapcar
              '(lambda (p)
                 (mapcar '+
                         (mapcar '(lambda (r) (apply '+ (mapcar '* r p))) m)
                         b
                 )
               )
              l
            )
          )
           (list
             (list (cos r) (sin (- r)) 0.0)
             (list (sin r) (cos r) 0.0)
             '(0.0 0.0 1.0)
           )
         )
  )
  ;;返回(list 左下角点 右下角点 右上角点 左上角点)
  (mapcar '(lambda (x) (trans x n 0)) l)
)[/pcode]

Lispboy

Faster 发表于 2013-5-2 12:24

                               
登录/注册后可看大图

tbox2函数在210不为'(0 0 1)的情况下不能得到正确结果！

你提供的图 210 是 '(0 0 1)啊，只是X,Y轴旋转了。

st788796

Faster 发表于 2013-5-2 12:29
谢谢楼上的各位，参考LeeMac的代码，计算Text/Mtext包围框的函数如下：
;;;(getTextBox ename) 返回Text、 ...

对含有分栏的Mtext还有待改进