多行文字 包围盒
;选择集包围盒 -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: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
) 本帖最后由 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)
)
)
)
)
本帖最后由 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))
)
)
)
都是炸开再获取的.
除非你愿意做一个渲染文字的功能,不过凭借lisp的技术栈应该做不到.
我也是经过好几年学习才知道文字渲染是怎么做的. 影响多行文字包围盒的因素是这个，你提前把这个值改成0，再获取就行了。
aws 发表于 2024-8-28 17:28
影响多行文字包围盒的因素是这个，你提前把这个值改成0，再获取就行了。
但是宽度决定了换行符插入 支持一下，很厉害 大佬厉害啊 kozmosovia 发表于 2024-8-28 18:07
直接获取文本框四点坐标
(Defun MTEXTBOX (obj / B ENX H J N O R W)
(if (and (= "MTEXT" (cdr ...
这个可以，，谢谢！ 楼上的代码要要怎样运行的？lisp吗
页:
[1]
2