日志
收藏无痕的改标注高度 希望日后可以加入单多行文字高度一起修改
热度 1 |
-
;| dmth ＝ 改变标注文字高度. by lxx.2008.4 -
说明：1.标注文字高度受到文本style影响，如果style默认高度不为0，直接put-TextHeight无效.
-
2.本程序考虑了不同标注类型的文本及全局比例，统一按指定高度改变.
-
3.公差可同比缩放.
-
|;
-
(defun c:dmth (/ h ss i e o st sts)
-
(vl-load-com)
-
(command ".undo" "be")
-
(setq h (getdist "\n 指定标注文字高度:"))
-
(setq ss (ssget '((0 . "DIMENSION")))
-
i -1
-
)
-
(while (setq e(ssname ss (setq i (1+ i))))
-
(setq o (vlax-ename->vla-object e))
-
(setq st (vlax-ename->vla-object (tblobjname "style" (vla-get-TextStyle o)))
-
sth (vla-get-height st))
-
(if (/= 0. sth)
-
(progn
-
(setq sts (cons (list st sth) sts))
-
(vla-put-height st 0.)
-
)
-
)
-
(vla-put-TextHeight o (/ h (vla-get-ScaleFactor o)))
-
)
-
(if sts (mapcar '(lambda(x)(vla-put-height (car x)(cadr x)))sts))
-
(command ".undo" "e")
-
(princ)
-
)
-
-
-
-
如果上下两个程序能合并就完美了！可以一键统一字高的问题了
统一字高度和文字样式
;;统一字高
(defun C:w2 (/ E EN N NAME OBJ SCL SS STY TEXTH)
(cond
((and (princ "\n 选择源：")
(setq e (ssget "_+.:E:S" '((0 . "*TEXT,*DIMENSION"))))
)
(setq e (ssname e 0))
(setq en (entget e))
(setq Name (cdr (assoc 0 en)))
(cond ((equal Name "DIMENSION")
(setq obj (vlax-ename->vla-object e))
(setq sty (vlax-get obj 'TextStyle))
(setq scl (vlax-get obj 'ScaleFactor))
(setq TextH (vlax-get obj 'TextHeight))
)
((wcmatch Name "*TEXT")
(setq TextH (cdr (assoc 40 en)))
(setq sty (cdr (assoc 7 en)))
(setq scl 1)
)
)
(while (and(princ "\n 选择目标：")(setq ss (ssget ":S" '((0 . "*TEXT,*DIMENSION")))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq en(entget e))
(setq Name (cdr (assoc 0 en)))
(cond ((equal Name "DIMENSION")
(setq obj (vlax-ename->vla-object e))
(vlax-put obj 'TextStyle sty)
(vlax-put obj 'ScaleFactor scl)
)
((wcmatch Name "*TEXT")
(setq en(entget e))
(setq en (subst (cons 7 sty) (assoc 7 en) en))
(entmod (subst (cons 40 (* TextH scl)) (assoc 40 en) en))
)
)
)
)
)
)
(princ)
)
