求框选改字体LISP

lohas1118

求框选改字体LISP
字体样式名:william
SHX字体:gbenor.shx
大字体:gbcbig.shx

langjs

以前编的一个程序，仅供参考
;;; ================================================
;;; 名称：字体统一
;;; 说明：本程序将图中所有文字的字体替换成指定字体。
;;; 命令：zt　        　by：langjs        2012.2.1
;;; ================================================
(defun c:zt (/ bb f file i lst ss txtsz x)
  (setvar "cmdecho" 0)
  (if (setq ss (ssget  '((0 . "*TEXT,ATTDEF"))))
    (progn
      (command ".UNDO" "BE")
      (setq txtsz "Hztxts");;;要替换的字体
      (while (setq x (tblnext "STYLE" (not x)))
        (setq lst (cons (cdr (assoc 2 x)) lst))
      )
      (setq lst (reverse lst))
      (repeat (setq i (length lst))
        (command "STYLE" (nth (setq i (1- i))
                              lst
                         ) (strcat "romans," txtsz) "" "0.7" "" "" ""
        )
        (if (/= 0 (getvar "cmdactive"))
          (command "_no")
        )
      )
      (repeat (setq i (sslength ss))
        (entmod (entget (ssname ss (setq i (1- i)))))
      )
      (command ".UNDO" "E")
    )
  )
  (princ)
)

e2002

工具栏,对象属性管理器上都可以直接改,不需要程序或者命令的

lohas1118

e2002 发表于 2012-2-16 11:35
工具栏,对象属性管理器上都可以直接改,不需要程序或者命令的

呵呵,命令用惯了.

e2002

lohas1118 发表于 2012-2-16 13:36
呵呵,命令用惯了.

要与时俱进啊...明明有更高效省力的不用,这不是自找麻烦吗?

lohas1118

e2002 发表于 2012-2-20 22:18
要与时俱进啊...明明有更高效省力的不用,这不是自找麻烦吗?

多谢版主教诲

lgttblue

启暖？