原创分享：透视图尺寸及文字美化，画管路透视图可能方便些
;;; =================================================================;;; 透视图尺寸美化
;;; 作者：langjs 命令：TC 日期2010年12月24日
;;; =================================================================
;;;
(defun c:TC (/ ent i mspace name p10 p10x p10y p11 p11x p11y p13 p13x p13y p14 p14x p14y ss)
(setvar "cmdecho" 0) ; 关闭命令响应
(COMMAND ".UNDO" "BE")
(if (tblsearch "style" "+30") ; 判断是否存文字样式"+30"倾斜30度字体，有则设为当前，无则创建
(princ)
(command "_style" "+30" "txt.shx,hztxts.shx" 0 0.8 30 "N" "N")
)
(if (tblsearch "style" "-30") ; 判断是否存在文字样式"-30"倾斜－30度字体，无则创建
(princ)
(command "_style" "-30" "txt.shx,hztxts.shx" 0 0.8 -30 "N" "N")
)
(if (not (tblsearch "dimstyle" "+30")) ; 判断是否存标注样式"+30"倾斜30度的标注样式，无则创建
(progn
(command "DIMTXSTY" "+30")
(command "dimstyle" "s" "+30")
)
)
(if (not (tblsearch "dimstyle" "-30")) ; 判断是否存标注样式"－30"倾斜－30度的标注样式，无则创建
(progn
(command "DIMTXSTY" "-30")
(command "dimstyle" "s" "-30")
)
)
(VL-LOAD-COM)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace (vla-get-ModelSpace Acaddocument)
)
(setq ss (ssget '((0 . "DIMENSION")))) ; 选择标注尺寸。
(setq i 0)
(REPEAT (SSLENGTH ss) ; 循环逐个判断尺寸的情况后，赋予不同的标注样式
(SETQ name (SSNAME ss i))
(setq ent (entget name)) ; 取得标注尺寸各关键坐标点值
(setq p10 (cdr (assoc 10 ent))
p14 (cdr (assoc 14 ent))
p11 (cdr (assoc 11 ent))
p13 (cdr (assoc 13 ent))
)
(setq p10x (FIX (+ 0.5 (car p10)))
p10y (FIX (+ 0.5 (cadr p10)))
p14x (FIX (+ 0.5 (car p14)))
p14y (FIX (+ 0.5 (cadr p14)))
p11x (car p11)
p11y (cadr p11)
p13x (car p13)
p13y (cadr p13)
) ; 判断关键点坐标并赋予不同的标注样式
(cond
((or
(and
( p10x p14x)
(> p10y p14y)
)
) ; 位置在右上和左下的尺寸。
(progn
(setq tstyle "+30") ; 赋予文字样式为倾斜30度。
(SETQ ss_VLA (vlax-ename->vla-object (SSNAME ss i)))
(vla-put-TextStyle ss_VLA TSTYLE)
(command "dimedit" "o" name "" 30) ; 尺寸倾斜30度。
(vla-Regen AcadDocument acAllViewports)
)
)
((or
(and
(> p10x p14x)
( p10y p14y)
)
) ; 位置在左上和右下的尺寸。
(progn
(setq tstyle "-30") ; 赋予文字样式为倾斜－30度。
(SETQ ss_VLA (vlax-ename->vla-object (SSNAME ss i)))
(vla-put-TextStyle ss_VLA TSTYLE)
(command "dimedit" "o" name "" -30) ; 尺寸倾斜－30度。
(vla-Regen AcadDocument acAllViewports)
)
)
(t
(princ)
) ; 其他位置水平和竖直的尺寸不变。
)
(setq i (1+ i))
) ; 循环结束。
(COMMAND ".UNDO" "E")
(princ)
)
;;; =================================================================
;;; 透视图文字美化
;;; 作者：langjs 命令：TW 日期2010年12月24日
;;; =================================================================
;;;
(defun c:TW (/ ang ent ent1)
(setvar "cmdecho" 0) ; 关闭命令响应
(COMMAND ".UNDO" "BE")
(if (tblsearch "style" "+30") ; 判断是否存文字样式"+30"倾斜30度字体，有则设为当前，无则创建
(princ)
(command "_style" "+30" "txt.shx,hztxts.shx" 0 0.8 30 "N" "N")
)
(if (tblsearch "style" "-30") ; 判断是否存在文字样式"-30"倾斜－30度字体，无则创建
(princ)
(command "_style" "-30" "txt.shx,hztxts.shx" 0 0.8 -30 "N" "N")
)
(while (setq ent1 (car (entsel "\n选择文字："))
ent ent1
)
(setq ent (entget ent))
(if (= "MTEXT" (cdr (assoc 0 ent))) ; 如选多行文本，则转化为单行文本
(COMMAND ".EXPLODE" ent1 "")
(princ)
)
(COMMAND ".UNDO" "BE")
(cond
((and
(= (* pi (/ 30 180.0)) (cdr (assoc 50 ent)))
(= "-30" (cdr (assoc 7 ent)))
) ; 更新单行文本的旋转角度。
(progn
(setq ang (* pi (/ 30 180.0)))
(setq ent (subst
(cons 50 ang)
(assoc 50 ent)
ent
)
)
(entmod ent)
(command ".change" ent1 "" "" "" "+30" "" "" "") ; 更新单行文本的文字样式。
)
)
((and
(= (* pi (/ 30 180.0)) (cdr (assoc 50 ent)))
(= "+30" (cdr (assoc 7 ent)))
)
(progn
(setq ang (* pi (/ -30 180.0)))
(setq ent (subst
(cons 50 ang)
(assoc 50 ent)
ent
)
)
(entmod ent)
(command ".change" ent1 "" "" "" "-30" "" "" "")
)
)
((and
(= (* pi (/ 330 180.0)) (cdr (assoc 50 ent)))
(= "-30" (cdr (assoc 7 ent)))
)
(progn
(setq ang (* pi (/ -30 180.0)))
(setq ent (subst
(cons 50 ang)
(assoc 50 ent)
ent
)
)
(entmod ent)
(command ".change" ent1 "" "" "" "+30" "" "" "")
)
)
((and
(= (* pi (/ 330 180.0)) (cdr (assoc 50 ent)))
(= "+30" (cdr (assoc 7 ent)))
)
(progn
(setq ang (* pi (/ 30 180.0)))
(setq ent (subst
(cons 50 ang)
(assoc 50 ent)
ent
)
)
(entmod ent)
(command ".change" ent1 "" "" "" "-30" "" "" "")
)
)
(t
(progn
(setq ang (* pi (/ 30 180.0)))
(setq ent (subst
(cons 50 ang)
(assoc 50 ent)
ent
)
)
(entmod ent)
(command ".change" ent1 "" "" "" "-30" "" "" "")
)
)
)
(COMMAND ".UNDO" "E")
)
(princ)
)
看看效果图片
狼大侠，程序运行提示如下，用不了怎么回事？
命令: tc hztxts.shx 是常规字体，不是大字体。0
0.800000 这个看起来不错，虽然用不上
怎么样修改成水平与垂直的均改成倾斜的
这个看起来不错
页:
[1]