[LISP程序]：修改、统一字体(源码)

jiega · 发表于 2005-12-4 16:44:08

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;修改、统一字体

(defun c:UnifyTxtStyle(/ style ss n num
ent_name ent oldstyle oldscale newstyle
newscale
)
(setvar "CMDECHO" 0)
(setq style (getvar "TEXTSTYLE"))
(if (= style_new nil)
(setq style_new style)
)
(if (and (setq ss (ssget '((0 . "TEXT")))
n (sslength ss)
num 0
)
)
(progn
(setq style (getstring
(strcat "\n输入字体样式名:<" style_new ">")
)
)
(while (and (null (tblsearch "style" style)) (/= style ""))
(progn
(princ "\n字体样式名称不存在，请重新输入")
(setq style (getstring
(strcat "\n输入字体样式名:<" style_new ">")
)
)
)
)
(if (= style "")
(setq style style_new)
(setq style_new style)
)
(repeat n
(setq ent_name (ssname ss num)
ent (entget ent_name)
oldstyle (assoc 7 ent)
oldscale (assoc 41 ent)
newstyle (cons (car oldstyle) style_new)
newscale (cons 41 0.75)
ent (subst newstyle oldstyle ent)
)
(setq ent (subst newscale oldscale ent))
(entmod ent)
(setq num (+ 1 num))
)
(princ (strcat "\n共处理了 "
(itoa num)
" 行文本，请继续..."
)
)
)
)
(setvar "CMDECHO" 1)
(princ)
)

(defun c:UnifyTxtStyle(/               style         ss           n             num 
             ent_name  ent         oldstyle  oldscale  newstyle 
             newscale 
            ) 
  (setvar "CMDECHO" 0) 
  (setq style (getvar "TEXTSTYLE")) 
  (if (= style_new nil) 
    (setq style_new style) 
  ) 
  (if (and (setq ss  (ssget '((0 . "TEXT"))) 
                 n   (sslength ss) 
                 num 0 
           ) 
      ) 
    (progn 
      (setq style (getstring 
                    (strcat "\n输入字体样式名:<" style_new ">") 
                  ) 
      ) 
      (while (and (null (tblsearch "style" style)) (/= style "")) 
        (progn 
          (princ "\n字体样式名称不存在，请重新输入") 
          (setq        style (getstring 
                        (strcat "\n输入字体样式名:<" style_new ">") 
                      ) 
          ) 
        ) 
      ) 
      (if (= style "") 
        (setq style style_new) 
        (setq style_new style) 
      ) 
 
      (repeat n 
        (setq ent_name (ssname ss num) 
              ent      (entget ent_name) 
              oldstyle (assoc 7 ent) 
              oldscale (assoc 41 ent) 
              newstyle (cons (car oldstyle) style_new) 
              newscale (cons 41 0.75) 
              ent      (subst newstyle oldstyle ent) 
        ) 
        (setq ent (subst newscale oldscale ent)) 
        (entmod ent) 
        (setq num (+ 1 num)) 
      ) 
      (princ (strcat "\n共处理了 " 
                     (itoa num) 
                     " 行文本，请继续..." 
             ) 
      ) 
    ) 
  ) 
  (setvar "CMDECHO" 1) 
  (princ) 
)

ltjxl · 发表于 2005-12-4 21:22:51

有用吗？贴个效果图或者动画演示一下嘛！

jiega · 发表于 2005-12-5 07:42:09

当然有用了,可以将选中的文字统一为一种字体,其他属性(高度,角度,图层等)不变

egos · 发表于 2005-12-5 09:06:23

CAD里不是可以直接选中需要修改的字体，然后在特性里更改成为另外的字体样式吗？

苦苦求索 · 发表于 2005-12-5 09:21:54

这个怎么用啊，
是把这个复制下来，存为LSP，放到CAD的安装目录下就可以了
还是要怎么做啊，

ss1025 · 发表于 2005-12-5 16:29:56

对，然后就是加载了。用appload命令，或从菜单里找

风云 · 发表于 2005-12-6 09:39:49

AUTOCAD自带的chtext.lsp功能很全啊

jiega · 发表于 2005-12-6 20:12:12

AUTOCAD自带的chtext.lsp是很全,cad 本身也可以做到. 但是有时使用起来并不是很方便. 如果能够将其功能拆分,并形成自己的快捷方式,这可以提高绘图效率.

jeson0113 · 发表于 2005-12-18 10:57:50

好的，我用一下，试试！

qjcpj · 发表于 2005-12-18 18:46:45

建议添加对话框，字体样式名可由下拉列表框中选取(当前图形数据库中的字体样式)。

惟有杜康 · 发表于 2005-12-21 15:39:05

我认为10楼说的很在理，这才体现了lisp辅助设计的效率

大雪无痕 · 发表于 2005-12-22 21:18:32

好东东，顶一下

王栋梁 · 发表于 2005-12-23 22:51:46

10楼的建议很好,望楼主修改一下.

hckdk · 发表于 2005-12-24 13:24:36

加载了之后怎么用？

它山之石 · 发表于 2005-12-24 15:51:46

用“格式刷”也可以呀

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：修改、统一字体(源码)

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子