多行文字包围盒

yaojing38 · 发表于 2024-8-28 17:06:19

;选择集包围盒 -Lee Mac
(defun LM:ssboundingbox(sel / idxllp ls1 ls2 obj urp)
(repeat (setq idx(sslength sel))
(setq obj (vlax-ename->vla-object(ssname sel(setq idx (1- idx)))))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(setq ls1 (cons (vlax-safearray->list llp) ls1)
ls2 (cons (vlax-safearray->list urp) ls2)
)
)
)
(if (and ls1 ls2)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)
)

以上是 lee 大佬的集合包围盒，发现对包含多行文字并不准确，不知有没有大佬有好的，可以分享下？不胜感激！

yaojing38 · 发表于 2024-8-29 11:20:14

本帖最后由 yaojing38 于 2024-8-29 11:22 编辑

谢谢大佬们的解答，，摸了一点门道，，扩展了下

;选择集包围盒 -Lee Mac
(defun LM:ssboundingboxex(sel / idxllp ls1 ls2 obj urp)
(repeat (setq idx(sslength sel))
(setq ent (ssname sel (setq idx (1- idx))))
(if (= "MTEXT" (cdr (assoc 0 (entget ent))))
(progn
(if (setq box11 (MTEXTBOX ent))
(setq ls1 (cons (cadr box11) ls1)
ls2 (cons (car box11) ls2)
)
)
)
(progn
(setq obj (vlax-ename->vla-object(ssname sel idx)))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(setq ls1 (cons (vlax-safearray->list llp) ls1)
ls2 (cons (vlax-safearray->list urp) ls2)
)
)
)
)
)
(if (and ls1 ls2 (princ ls1))
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)
)
;选择集包围盒 -Lee Mac
(defun LM:ssboundingbox(sel / idxllp ls1 ls2 obj urp)
(repeat (setq idx(sslength sel))
(setq obj (vlax-ename->vla-object(ssname sel(setq idx (1- idx)))))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(setq ls1 (cons (vlax-safearray->list llp) ls1)
ls2 (cons (vlax-safearray->list urp) ls2)
)
)
)
(if (and ls1 ls2)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)
)
;获取文本框四点坐标
(Defun MTEXTBOX (obj1 / B ENX H J N O R W)
(if (and (= "MTEXT" (cdr (assoc 0 (setq enx (entget obj1)))))
(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))
r1 (angle '(0.0 0.0 0.0) (trans (cdr (assoc 10 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 box1
(list
;(list (- (car o)) (- (cadr o)))
(polar (polar (list (+ (car o) w) (- (cadr o))) r1 (distance '(0 0 0) b)) (* -0.5 pi) h)
;(list (+ (car o) w) (- (cadr o)))
;(list (+ (car o) w) (+ (cadr o) h))
(polar (polar (list (- (car o)) (+ (cadr o) h)) r1 (distance '(0 0 0) b)) (* -0.5 pi) h)
)
)
;(list (- (car o)) (+ (cadr o) h))
)
(vl-cmdf "RECTANG" (car box1) (cadr box1))
box1
)

;选择集包围盒 -Lee Mac 
(defun LM:ssboundingboxex(sel / idxllp ls1 ls2 obj urp) 
(repeat (setq idx(sslength sel)) 
(setq ent (ssname sel (setq idx (1- idx)))) 
(if (= "MTEXT" (cdr (assoc 0  (entget ent)))) 
(progn 
        (if (setq box11 (MTEXTBOX ent)) 
         
        (setq ls1 (cons (cadr box11) ls1) 
ls2 (cons (car box11) ls2) 
) 
) 
         
) 
(progn 
(setq obj (vlax-ename->vla-object(ssname sel idx))) 
(if (and (vlax-method-applicable-p obj 'getboundingbox) 
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) 
) 
(setq ls1 (cons (vlax-safearray->list llp) ls1) 
ls2 (cons (vlax-safearray->list urp) ls2) 
) 
) 
) 
) 
) 
(if (and ls1 ls2 (princ ls1)) 
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) 
)    
) 
;选择集包围盒 -Lee Mac 
(defun LM:ssboundingbox(sel / idxllp ls1 ls2 obj urp) 
(repeat (setq idx(sslength sel)) 
(setq obj (vlax-ename->vla-object(ssname sel(setq idx (1- idx))))) 
(if (and (vlax-method-applicable-p obj 'getboundingbox) 
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) 
) 
(setq ls1 (cons (vlax-safearray->list llp) ls1) 
ls2 (cons (vlax-safearray->list urp) ls2) 
) 
) 
) 
(if (and ls1 ls2) 
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) 
)    
) 
;获取文本框四点坐标 
(Defun MTEXTBOX        (obj1 / B ENX H J N O R W) 
  (if (and (= "MTEXT" (cdr (assoc 0 (setq enx (entget obj1))))) 
           (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)) 
                                                     r1 (angle  '(0.0 0.0 0.0) (trans (cdr (assoc 10 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 box1 
    (list   
                             ;(list (- (car o)) (- (cadr o))) 
                             (polar (polar (list (+ (car o) w) (- (cadr o)))  r1 (distance '(0 0 0) b)) (* -0.5 pi) h) 
          ;(list (+ (car o) w) (- (cadr o))) 
           ;(list (+ (car o) w) (+ (cadr o) h)) 
                             (polar (polar (list (- (car o)) (+ (cadr o) h)) r1 (distance '(0 0 0) b)) (* -0.5 pi) h) 
                         
                         
                ) 
                ) 
          ;(list (- (car o)) (+ (cadr o) h)) 
    ) 
         
        (vl-cmdf "RECTANG" (car box1) (cadr box1)) 
        box1 
  )

yaojing38 · 发表于 2024-8-30 14:11:28

本帖最后由 yaojing38 于 2024-8-30 14:44 编辑

kozmosovia 发表于 2024-8-30 13:54
完整的函数
https://zhuanlan.zhihu.com/p/25228344

谢谢您的代码！

<div class="blockcode"><blockquote>;Example
;(AQX: GETMTEXTBOX (car(entsel)) 0.0)
;((97346.9291.883)(61132.620869.7)(56983.413567.6)(93197.6-7010.23))
;直接获取文本框四点坐标
(Defun AQX:GETMTEXTBOX (obj off / MXV B ENX H J L M N O P R W)
(Defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(setq enx (entget obj))
(if (null off)
(setq off 0.0)
)
(if
(setq l
(cond
((= "TEXT" (cdr (assoc 0 enx)))
(setq b (cdr (assoc 10 enx))
r (cdr (assoc 50 enx))
l (textbox enx)
)
(list
(list (- (caar l) off) (- (cadar l) off))
(list (+ (caadr l) off) (- (cadar l) off))
(list (+ (caadr l) off) (+ (cadadr l) off))
(list (- (caar l) off) (+ (cadadr l) off))
)
)
((= "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) off) (- (cadr o) off))
(list (+ (car o) w off) (- (cadr o) off))
(list (+ (car o) w off) (+ (cadr o) h off))
(list (- (car o) off) (+ (cadr o) h off))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l))
(list
(list (cos r) (sin (- r)) 0.0)
(list (sin r) (cos r) 0.0)
'(0.0 0.0 1.0)
)
)
)
)

<div class="blockcode"><blockquote>;Example 
;(AQX: GETMTEXTBOX (car(entsel)) 0.0) 
;((97346.9291.883)(61132.620869.7)(56983.413567.6)(93197.6-7010.23)) 
;直接获取文本框四点坐标 
(Defun AQX:GETMTEXTBOX (obj off / MXV B ENX H J L M N O P R W) 
  (Defun mxv (m v) 
    (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) 
  ) 
  (setq enx (entget obj)) 
  (if (null off) 
    (setq off 0.0) 
  ) 
  (if 
    (setq l 
     (cond 
       ((= "TEXT" (cdr (assoc 0 enx))) 
        (setq b (cdr (assoc 10 enx)) 
        r (cdr (assoc 50 enx)) 
        l (textbox enx) 
        ) 
        (list 
        (list (- (caar l) off) (- (cadar l) off)) 
        (list (+ (caadr l) off) (- (cadar l) off)) 
        (list (+ (caadr l) off) (+ (cadadr l) off)) 
        (list (- (caar l) off) (+ (cadadr l) off)) 
        ) 
       ) 
       ((= "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) off) (- (cadr o) off)) 
        (list (+ (car o) w off) (- (cadr o) off)) 
        (list (+ (car o) w off) (+ (cadr o) h off)) 
        (list (- (car o) off) (+ (cadr o) h off)) 
        ) 
       ) 
     ) 
    ) 
  ((lambda (m) 
   (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)) 
   (list 
   (list (cos r) (sin (- r)) 0.0) 
   (list (sin r) (cos r) 0.0) 
   '(0.0 0.0 1.0) 
   ) 
  ) 
  ) 
)

kozmosovia · 发表于 2024-8-28 18:07:43

本帖最后由 kozmosovia 于 2024-8-28 18:08 编辑

直接获取文本框四点坐标
(Defun MTEXTBOX       (obj / B ENX H J N O R W)
  (if (and (= "MTEXT" (cdr (assoc 0 (setq enx (entget obj)))))
         (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))
)
  )
)

你有种再说一遍 · 发表于 2024-8-28 17:23:34

都是炸开再获取的.
除非你愿意做一个渲染文字的功能,不过凭借lisp的技术栈应该做不到.
我也是经过好几年学习才知道文字渲染是怎么做的.

aws · 发表于 2024-8-28 17:28:49

影响多行文字包围盒的因素是这个，你提前把这个值改成0，再获取就行了。

你有种再说一遍 · 发表于 2024-8-28 17:43:37

aws 发表于 2024-8-28 17:28
影响多行文字包围盒的因素是这个，你提前把这个值改成0，再获取就行了。

但是宽度决定了换行符插入

wojiaohuyong · 发表于 2024-8-28 17:49:57

支持一下，很厉害

zhangkui9070 · 发表于 2024-8-28 19:43:56

大佬厉害啊

yaojing38 · 发表于 2024-8-29 11:23:28

kozmosovia 发表于 2024-8-28 18:07
直接获取文本框四点坐标
(Defun MTEXTBOX (obj / B ENX H J N O R W)
(if (and (= "MTEXT" (cdr ...

这个可以，，谢谢！

advksf · 发表于 2024-8-29 23:33:50

楼上的代码要要怎样运行的？lisp吗

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

[经验] 多行文字包围盒

点评

本帖子中包含更多资源

[经验] 多行文字 包围盒

点评

本帖子中包含更多资源

[经验] 多行文字包围盒