文本包围框
(defun c:tt (/ box1 box2 dis i pt pt1 pt2 pt3 pt4 pts s1 ss_txt txt)(setvar "cmdecho" 0)
;边框是否放大
(if (= eh_bgoff_dis_g nil)
(setq eh_bgoff_dis_g 0)
)
(princ "\n如需放大外包框请输入偏移距离<")(princ eh_bgoff_dis_g)(princ ">:")
(setq dis (getdist))
(if (= dis nil)
(setq dis eh_bgoff_dis_g)
(setq eh_bgoff_dis_g dis)
)
(setq ss_txt (ssget '((0 . "TEXT,MTEXT"))))
(setq i -1)
(while (setq s1 (ssname ss_txt (setq i (1+ i))))
(if (EH-Get-EntTypeCompare s1 "TEXT")
(progn
(setq txt (EH-Get-EntDxf s1 '(40 1 10 41)))
(setq pt (caddr txt))
(setq pts (textbox (list (cons 40 (car txt)) (cons 1 (cadr txt))(cons 41 (nth 3 txt)))))
(setq pt1 (EH-Vector-Add pt (car pts)))
(setq pt3 (EH-Vector-Add pt (cadr pts)))
(setq pt2 (list (car pt1)(cadr pt3)))
(setq pt4 (list (car pt3)(cadr pt1)))
)
)
(if (EH-Get-EntTypeCompare s1 "MTEXT")
(progn
(setq pt1 (EH-Get-EntDxf s1 '(10 42 43)))
(setq box1 (cadrpt1))
(setq box2 (caddr pt1))
(setq pt2 (car pt1))
(setq pt1 (list (car pt2) (- (cadr pt2) box2)))
(setq pt3 (list (+ (car pt2) box1) (cadr pt2)))
(setq pt4 (list (+ (car pt2) box1) (- (cadr pt2) box2)))
)
)
(if (= dis 0)
nil
(setq
pt1 (list (- (car pt1) dis) (+ (cadr pt1) dis))
pt2 (list (- (car pt2) dis) (- (cadr pt2) dis))
pt3 (list (+ (car pt3) dis) (- (cadr pt3) dis))
pt4 (list (+ (car pt4) dis) (+ (cadr pt4) dis))
);setq
)
(if pt4
(entmake
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(8 . "中Z-13----标注")
'(90 . 4)
'(70 . 1)
(cons 10 pt1)
(cons 10 pt2)
(cons 10 pt3)
(cons 10 pt4)
)
)
)
)
(setvar "cmdecho" 1)
(princ)
) ;defun_end
沙发顶楼主一个 缺少自定义函数：EH-Get-EntDxf、EH-Get-EntTypeCompare、EH-Vector-Add
页:
[1]