原创分享：透视图尺寸及文字美化，画管路透视图可能方便些

langjs

;;; =================================================================
;;; 透视图尺寸美化
;;; 作者：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)
  )
  (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)
  )
  (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)
)

langjs

看看效果图片

半听可乐

langjs 发表于 2010-12-25 02:10
看看效果图片

狼大侠，程序运行提示如下，用不了怎么回事？

命令: tc hztxts.shx 是常规字体，不是大字体。0
0.800000

朽木大师

这个看起来不错，虽然用不上

朽木大师

怎么样修改成水平与垂直的均改成倾斜的

ZYX2129

这个看起来不错