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

langjs · 发表于 2010-12-25 02:09:00

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