明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3028|回复: 5

[函数] 原创分享:透视图尺寸及文字美化,画管路透视图可能方便些

[复制链接]
发表于 2010-12-25 02:09:09 | 显示全部楼层 |阅读模式
;;; =================================================================
;;; 透视图尺寸美化
;;; 作者: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)
)
"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2010-12-25 02:10:55 | 显示全部楼层
看看效果图片

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2012-8-26 18:02:52 | 显示全部楼层
langjs 发表于 2010-12-25 02:10
看看效果图片

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

命令: tc hztxts.shx 是常规字体,不是大字体。0
0.800000
发表于 2013-5-6 12:01:17 | 显示全部楼层
这个看起来不错,虽然用不上
发表于 2013-5-7 16:27:52 | 显示全部楼层
本帖最后由 朽木大师 于 2013-5-7 16:29 编辑

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2022-7-31 14:05:30 | 显示全部楼层
这个看起来不错
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-6 09:56 , Processed in 0.187797 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表