尺寸不炸开，如何得标注包围盒?

/db_自贡黄明儒_ · 发表于 2014-10-27 11:41:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 /db_自贡黄明儒_ 于 2014-10-27 12:09 编辑

尺寸不炸开，得标注文字包围盒，有什么好方法？

iLisp · 发表于 2014-10-27 11:46:09

标注可以直接用boundingbox

/db_自贡黄明儒_ · 发表于 2014-10-27 11:53:05

iLisp 发表于 2014-10-27 11:46
标注可以直接用boundingbox

有这个函数吗？

iLisp · 发表于 2014-10-27 11:53:19

非要倾斜的就用10 11 12 13 组码加出头变量文字大小角度等构造点表，按倾斜坐标系计算box
vla-getboundingbox

iLisp · 发表于 2014-10-27 12:21:25

文字可以取得插入点，用nentselp获取并转换object再求box

另外标注也是块,由块定义内的文字求box，然后用矩阵转换到实际位置也可以

/db_自贡黄明儒_ · 发表于 2014-10-27 13:24:12

本帖最后由 /db_自贡黄明儒_ 于 2014-10-27 14:13 编辑

iLisp 发表于 2014-10-27 12:21
文字可以取得插入点，用nentselp获取并转换object再求box

另外标注也是块,由块定义内的文字求box，然后 ...

(defun C:w1 (/ B E EN MAXPT MINPT OBJ)
  (setq e (car (entsel)))
  (setq B (cdr (assoc 2 (entget e))))
  (setq e (TBLOBJNAME "Block" b))
  (while e
(setq en (entget e))
(cond ((equal (assoc 0 en) '(0 . "MTEXT")) (setq obj e) (setq e nil))
   (T (setq e (entnext e)))
)
  )
  ;|(setq en (entget obj))
  (setq
box (textbox
   (vl-remove-if-not '(lambda (x) (or (= (car x) 1) (= (car x) 7) (= (car x) 40)))
      en
   )
)
  )
  (setq p (cdr (assoc 10 en)))
  (setq box (mapcar '(lambda (x) (mapcar '+ x p)) box))
  (command "_.rectang" "non" (car box) "non" (cadr box))
  |;
  (setq obj (vlax-ename->vla-object obj))
  (vla-GetBoundingBox obj 'minPt 'maxPt)       ;得到包围框
  (setq minPt (vlax-safearray->list minPt))
  (setq maxPt (vlax-safearray->list maxPt))
  (command "_.rectang" "non" minPt "non" maxPt)
)
行不通的。

iLisp · 发表于 2014-10-27 21:03:47

/db_自贡黄明儒_ 发表于 2014-10-27 13:24
(defun C:w1 (/ B E EN MAXPT MINPT OBJ)
(setq e (car (entsel)))
(setq B (cdr (assoc 2 (entget e ...

你没有转换到实际位置

/db_自贡黄明儒_ · 发表于 2014-10-27 21:28:11

关键是出错了，运行不下去

XDSoft · 发表于 2014-10-27 23:24:36

/db_自贡黄明儒_ 发表于 2014-10-27 13:24
(defun C:w1 (/ B E EN MAXPT MINPT OBJ)
(setq e (car (entsel)))
(setq B (cdr (assoc 2 (entget e ...

用你的代码运行下，有结果啊。

QQ截图20141027232329.png

Free-Lancer · 发表于 2014-10-28 07:56:46

本帖最后由 Free-Lancer 于 2014-10-28 07:58 编辑

/db_自贡黄明儒_ 发表于 2014-10-27 13:24
(defun C:w1 (/ B E EN MAXPT MINPT OBJ)
(setq e (car (entsel)))
(setq B (cdr (assoc 2 (entget e ...

(defun DmTxtBox (e / _pnts:box _pnts:rotate
bn textstring height stylename
insertionpoint rotation box
v
)
(defun _pnts:box (box /)
(list (car box)
(list (caadr box) (cadar box) (last (car box)))
(cadr box)
(list (caar box) (cadadr box) (last (car box)))
)
)
(defun _pnts:rotate (pts pb an)
(mapcar '(lambda (p)
(polar pb (+ (angle p pb) an) (distance p pb))
)
pts
)
)
(setq bn (cdr (assoc 2 (entget e))))
(vlax-for obj (vla-item (fy:acblocks) bn)
(if (= (vla-get-objectname obj) "AcDbMText")
(progn
(mapcar
'set
'(textstring height stylename InsertionPoint rotation)
(fy:get obj
'(textstring height stylename InsertionPoint rotation)
)
)
(setq box
(textbox
(mapcar
'(lambda (x y)
(cons x y)
)
'(1 40 7)
(list textstring height stylename)
)
)
v (mapcar '- insertionpoint (apply 'fy:midp box))
box (mapcar '(lambda (p)
(mapcar '+ v p)
)
(_pnts:box box)
)
box (_pnts:rotate box InsertionPoint rotation)
)
)
)
)
box
)
(defun c:tt (/ _pline:make ss sl e box)
(defun _pline:make (pts)
(entmake
(append '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
)
(list (cons 90 (length pts))
'(70 . 1)
)
(mapcar '(lambda (x)
(cons 10 (list (car x) (cadr x)))
)
pts
)
)
)
)
(if (setq ss (ssget '((0 . "dimension"))))
(progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
(setq box (DmTxtBox e))
(_pline:make box)
)
)
)
(princ)
)

(defun DmTxtBox        (e             /                 _pnts:box   _pnts:rotate 
                 bn             textstring         height             stylename 
                 insertionpoint                 rotation    box 
                 v 
                ) 
  (defun _pnts:box (box /) 
    (list (car box) 
          (list (caadr box) (cadar box) (last (car box))) 
          (cadr box) 
          (list (caar box) (cadadr box) (last (car box))) 
    ) 
  ) 
  (defun _pnts:rotate (pts pb an) 
    (mapcar '(lambda (p) 
               (polar pb (+ (angle p pb) an) (distance p pb)) 
             ) 
            pts 
    ) 
  ) 
  (setq bn (cdr (assoc 2 (entget e)))) 
  (vlax-for obj        (vla-item (fy:acblocks) bn) 
    (if        (= (vla-get-objectname obj) "AcDbMText") 
      (progn 
        (mapcar 
          'set 
          '(textstring height stylename InsertionPoint rotation) 
          (fy:get obj 
                  '(textstring height stylename InsertionPoint rotation) 
          ) 
        ) 
        (setq box 
                  (textbox 
                    (mapcar 
                      '(lambda (x y) 
                         (cons x y) 
                       ) 
                      '(1 40 7) 
                      (list textstring height stylename) 
                    ) 
                  ) 
              v          (mapcar '- insertionpoint (apply 'fy:midp box)) 
              box (mapcar '(lambda (p) 
                             (mapcar '+ v p) 
                           ) 
                          (_pnts:box box) 
                  ) 
              box (_pnts:rotate box InsertionPoint rotation) 
        ) 
      ) 
    ) 
  ) 
  box 
) 
(defun c:tt (/ _pline:make ss sl e box) 
  (defun _pline:make (pts) 
    (entmake 
      (append '((0 . "LWPOLYLINE") 
                (100 . "AcDbEntity") 
                (100 . "AcDbPolyline") 
               ) 
              (list (cons 90 (length pts)) 
                    '(70 . 1) 
              ) 
              (mapcar '(lambda (x) 
                         (cons 10 (list (car x) (cadr x))) 
                       ) 
                      pts 
              ) 
      ) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "dimension")))) 
    (progn 
      (setq sl (sslength ss)) 
      (while (setq e (ssname ss (setq sl (1- sl)))) 
        (setq box (DmTxtBox e)) 
        (_pline:make box) 
      ) 
    ) 
  ) 
  (princ) 
)

炫翔 · 发表于 2014-10-28 09:05:36

Free-Lancer 发表于 2014-10-28 07:56

(= (vla-get-objectname obj) "AcDbMText") 测试返回NIL

炫翔 · 发表于 2014-10-28 09:08:16

(defun DmTxtBox (e / _pnts:box _pnts:rotate
bn textstring height stylename
insertionpoint rotation box
v
)
(defun _pnts:box (box /)
(list (car box)
(list (caadr box) (cadar box) (last (car box)))
(cadr box)
(list (caar box) (cadadr box) (last (car box)))
)
)
(defun _pnts:rotate (pts pb an)
(mapcar '(lambda (p)
(polar pb (+ (angle p pb) an) (distance p pb))
)
pts
)
)
(setq bn (cdr (assoc 2 (entget e))))
(vlax-for obj (vla-item (xx-blks) bn)
(if (= (vla-get-objectname obj) "AcDbMText")
(progn
(mapcar
'set
'(textstring height stylename InsertionPoint rotation)
(mapcar(function(lambda(x)
(vlax-get-property obj x)))
'(textstring height stylename InsertionPoint rotation)
)
)
(setq box
(textbox
(mapcar
'(lambda (x y)
(cons x y)
)
'(1 40 7)
(list textstring height stylename)
)
)
v (mapcar '- insertionpoint (apply 'fy:midp box))
box (mapcar '(lambda (p)
(mapcar '+ v p)
)
(_pnts:box box)
)
box (_pnts:rotate box InsertionPoint rotation)
)
)
)
)
box
)
(defun c:XX (/ _pline:make ss sl e box)
(defun _pline:make (pts)
(entmake
(append '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
)
(list (cons 90 (length pts))
'(70 . 1)
)
(mapcar '(lambda (x)
(cons 10 (list (car x) (cadr x)))
)
pts
)
)
)
)
(if (setq ss (ssget '((0 . "dimension"))))
(progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
(setq box (DmTxtBox e))
(_pline:make box)
)
)
)
(princ)
)
(setq xx-acad (vlax-get-acad-object)
xx-doc (vla-get-activedocument xx-acad);激活的文档
)
(defun xx-blks nil(vla-get-blocks xx-doc));块

(defun DmTxtBox        (e             /                 _pnts:box   _pnts:rotate 
                 bn             textstring         height             stylename 
                 insertionpoint                 rotation    box 
                 v 
                ) 
  (defun _pnts:box (box /) 
    (list (car box) 
          (list (caadr box) (cadar box) (last (car box))) 
          (cadr box) 
          (list (caar box) (cadadr box) (last (car box))) 
    ) 
  ) 
  (defun _pnts:rotate (pts pb an) 
    (mapcar '(lambda (p) 
               (polar pb (+ (angle p pb) an) (distance p pb)) 
             ) 
            pts 
    ) 
  ) 
  (setq bn (cdr (assoc 2 (entget e)))) 
  (vlax-for obj (vla-item (xx-blks) bn) 
    (if        (= (vla-get-objectname obj) "AcDbMText") 
      (progn 
        (mapcar 
          'set 
          '(textstring height stylename InsertionPoint rotation) 
          (mapcar(function(lambda(x) 
              (vlax-get-property obj x))) 
             '(textstring height stylename InsertionPoint rotation) 
          ) 
        ) 
        (setq box 
                  (textbox 
                    (mapcar 
                      '(lambda (x y) 
                         (cons x y) 
                       ) 
                      '(1 40 7) 
                      (list textstring height stylename) 
                    ) 
                  ) 
              v          (mapcar '- insertionpoint (apply 'fy:midp box)) 
              box (mapcar '(lambda (p) 
                             (mapcar '+ v p) 
                           ) 
                          (_pnts:box box) 
                  ) 
              box (_pnts:rotate box InsertionPoint rotation) 
        ) 
      ) 
    ) 
  ) 
  box 
) 
(defun c:XX (/ _pline:make ss sl e box) 
  (defun _pline:make (pts) 
    (entmake 
      (append '((0 . "LWPOLYLINE") 
                (100 . "AcDbEntity") 
                (100 . "AcDbPolyline") 
               ) 
              (list (cons 90 (length pts)) 
                    '(70 . 1) 
              ) 
              (mapcar '(lambda (x) 
                         (cons 10 (list (car x) (cadr x))) 
                       ) 
                      pts 
              ) 
      ) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "dimension")))) 
    (progn 
      (setq sl (sslength ss)) 
      (while (setq e (ssname ss (setq sl (1- sl)))) 
        (setq box (DmTxtBox e)) 
        (_pline:make box) 
      ) 
    ) 
  ) 
  (princ) 
) 
 
(setq xx-acad (vlax-get-acad-object) 
       xx-doc (vla-get-activedocument xx-acad);激活的文档 
) 
(defun xx-blks nil(vla-get-blocks xx-doc));块

04版本测试的

Free-Lancer · 发表于 2014-10-28 10:00:30

炫翔发表于 2014-10-28 09:08
04版本测试的

那就无能为力了，最低只有 2005 测试 Ok，08 12 14 15 Ok

/db_自贡黄明儒_ · 发表于 2014-10-28 16:08:14

炫翔发表于 2014-10-28 09:08
04版本测试的

textstring要去掉前面的控制符才行，不然包围盒太大了。

zhuizhu · 发表于 2014-11-15 16:42:09

/db_自贡黄明儒_ 发表于 2014-10-28 16:08
textstring要去掉前面的控制符才行，不然包围盒太大了。

怎么获取的是很大的外框？就是会超出很多
请大师详说，谢谢

账号		自动登录	找回密码
密码			立即注册

[研讨] 尺寸不炸开，如何得标注包围盒?

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

评分