返回Text、 MText的左下角点 右下角点 右上角点 左上角点
本帖最后由 jpg102329 于 2017-8-21 08:12 编辑;【管理员】大海<tryhi@sina.cn> 2017-07-16 20:48:08查看前后消息
;;返回Text、 MText的左下角点 右下角点 右上角点 左上角点
(defun try-get-TextBox (EN / b enx h j l n o r ty w)
(setq ty(type en))
(cond
((= 'VLA-OBJECT ty)
(setq enx (entget (vlax-vla-object->ename en)))
)
((= 'ename ty) (setq enx (entget en)))
((= 'list ty) (setq enx 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)
)
)
)
<以上内容出自《大海语录》不代表本人观点>
欢迎加入通信管线设计技术交流群655280537，通信管线规划设计技术、资源交流群，CAD底图交换、付费教程免费获取、交流经验、互相学习，共同进步！
Thanks for sharing. I'm finding this function
页:
[1]