[求助]：文本样式

lt_zzy · 发表于 2003-8-15 11:24:16

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

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

×

由于我要从一个字体转到另一种字体，以前的字体可能是不一样的。现在我要将它们都用作"txt.shx,hztxt.shx"。如果一个一个的改去实在有一些麻烦，要是图中字体样式比较多的话，这个特点就更突出了。
请各位朋友帮一个忙，给我做一个LSP或ARX，能一次性将图中所有的字体都改成我上面所说的那种。
谢谢！！！

aeo · 发表于 2003-8-15 23:01:46

设一字型"txt.shx,hztxt.shx"假定为aaa

(sssetfirst nil (ssget '((0 . "*text"))))

Ctrl+1 ,该样式到aaa

lt_zzy · 发表于 2003-8-17 09:12:06

aeo请说得详细一些好吗？
我不明白。

aeo · 发表于 2003-8-17 11:17:02

;用下面的试试
;其实上面就是这一过程
;1.设字型 2.选文字 3.用ctrl+1改字型.

;下面0.8是宽高比.自己调.
;把每个文字的字型改了
(defun c:cs (/ en j ss)
(command "undo" "group")
(if (not (tblsearch "STYLE" "hz-txt"))
(command "style" "hz-txt" "txt,hztxt" "0" "0.8" "" "" "" "")
)
(setq ss (ssget '((0 . "*text"))))
(repeat (progn
(setq j -1)
(sslength ss)
)
(setq en (entget (ssname ss (setq j (1+ j)))))
(entmod (setq en (subst
(cons 7 "hz-txt")
(assoc 7 en)
en
)
)
)
)
(command "undo" "end")
(princ)
)

当然也可以把所有的字型改为你要的.

;把每个字型定义改了
(defun c:cs( / styles doc)
(setq styles (vla-get-TextStyles(setq doc (vla-get-activedocument(vlax-get-acad-object)))))
(vlax-for st styles
(vla-put-FontFile st "txt.shx")
(vla-put-bigFontFile st "hztxt.shx")
)
(vla-regen doc acActiveViewport)
(princ)
)

lt_zzy · 发表于 2003-8-17 13:23:59

我自己也编写了一个：

[FONT=courier new]
((defun c:txt(/ style_list n i style_name style_name_list font bigfont)
(command "undo" "group")
(setq style_list (ai_table "style" 2))
(setq n (length style_list))
(setq i 0)
(repeat n
(setq style_name (nth i style_list))
(setq style_name_list (tblsearch "style" style_name))
(setq font (cdr (assoc 3 style_name_list)))
(setq bigfont (cdr (assoc 4 style_name_list)))
(if (or (/= font "txt.shx") (and (/= bigfont "HZTXT.shx") (/= bigfont "tjhzd.shx")))
(command "-style" style_name "txt.shx,hztxt.shx" "" "" "" "" "")
)
(setq i (1+ i))
)
(command "undo" "end")
princ()
)
[/FONT]

我感觉下面的这一句代码执行的很慢，请各位朋友指点！
(command "-style" style_name "txt.shx,hztxt.shx" "" "" "" "" "")
另外，在14下面与晓东工具箱好象有冲突。
错误: null function
((ST) (IF (AND (/= ST "Function cancelled") (/= ST "quit / exit abort")) (PRINC
(STRCAT "\n错误: " ST "\n"))) (XDRX_SYSVAR_POP) (XDRX_DRAWING_VIEWRES)
(XDRX_PBAREND) (XDRX_END) (SETQ *ERROR* $XDLSP_ERROR))*Cancel*

aeo · 发表于 2003-8-17 15:28:27

princ()不对

应该很慢，每个command都要刷新一下图.字多的话很慢的.

(defun c:txt( / bigfont font name sty)
(command "undo" "group")
(setq sty(tblnext "style" t))
(while sty
(setq name (cdr(assoc 2 sty)))
(setq font (cdr (assoc 3 sty)))
(setq bigfont (cdr (assoc 4 sty)))
(if (or (wcmatch font "txt.shx") (wcmatch bigfont "HZTXT.shx,tjhzd.shx") )
(command "-style" style_name "txt.shx,hztxt.shx" "" "" "" "" "")
)
(setq sty(tblnext "style"))
)
(command "undo" "end")
(princ)
)

lt_zzy · 发表于 2003-8-17 16:09:39

aeo：
请问能不能将
(command "-style" style_name "txt.shx,hztxt.shx" "" "" "" "" "")
改成别的语句，使它执行的更快一些。

aeo · 发表于 2003-8-17 19:43:18

既然都改成txt.hztxt
那还不如设一个txt.hztxt比如aaa
再把所有的字改为aaa
purge掉不要的.---第四贴上面的.

不过一个图也就一次,时间长不到哪去的,慢一点无仿.
如果用2000的话,第四贴下面的应该要快一点.

eachy · 发表于 2003-8-17 22:18:02

以前在论坛发过的。

;|
说明：safnt 重新定义图中所有字型定义，resfnt 恢复图中原始字型定义
需要XDRX_API支持，ONLY for 2000+
|;
(defun c:safnt (/ n stl $old_stl)
(xdrx_sysvar_push "textstyle")
(setq stl ($xdlsp_symbol->list "style"))
(setq
$old_stl (mapcar
'(lambda (x)
(list (car x)
(last x)
(if (/= (cdr (assoc 4 (entget (last x)))) "")
(strcat
(cdr
(assoc 3
(entget (last x))
)
)
","
(cdr
(assoc 4
(entget (last x))
)
)
)
(cdr (assoc 3 (entget (last x))))
)
)
;stl
)
stl
)
)
;;建立词典，随图保存
(vlax-ldata-put "#myaxis" "style" $old_stl)
(foreach n $old_stl
(setq _name (car n)
e (cadr n)
_styleshx (last n)
)
(if
(OR (wcmatch _styleshx "*ttf*")
(not
(findfile (strcat (cdr (assoc 3 (entget (cadr n)))) ".shx"))
)
(not
(findfile (strcat (cdr (assoc 4 (entget (cadr n)))) ".shx"))
)
(wcmatch _styleshx "*pfb")
)
(xdrx_setenttodb (cadr n))
(xdrx_modent 3 "gbenor.shx" 4 "gbcbig.shx")
)
)
(xdrx_object_regen)
(xdrx_sysvar_pop)
(xdrx_end)
(princ)
)
(defun c:resfnt (/ a oldtxtsty)
(setq oldtxtsty (getvar "textstyle"))
(setq a (vlax-ldata-get "#myaxis" "style"))
(foreach n a
(command "-style"
(car n)
(cadr n)
""
""
""
""
""
(if (= oldtxtsty (caar a))
""
)
)
(setq a (cdr a))
)
(command)
(vlax-ldata-delete "#myaxis" "style")
(setvar "textstyle" oldtxtsty)
(princ)
)

;| 
说明：safnt 重新定义图中所有字型定义，resfnt 恢复图中原始字型定义 
      需要XDRX_API支持，ONLY for 2000+ 
|; 
(defun c:safnt (/ n stl $old_stl) 
  (xdrx_sysvar_push "textstyle") 
  (setq stl ($xdlsp_symbol->list "style")) 
  (setq 
    $old_stl (mapcar 
               '(lambda        (x) 
                  (list        (car x) 
                        (last x) 
                        (if (/= (cdr (assoc 4 (entget (last x)))) "") 
                          (strcat 
                            (cdr 
                              (assoc 3 
                                     (entget (last x)) 
                              ) 
                            ) 
                            "," 
                            (cdr 
                              (assoc 4 
                                     (entget (last x)) 
                              ) 
                            ) 
                          ) 
                          (cdr (assoc 3 (entget (last x)))) 
                        ) 
                        
                  ) 
                                        ;stl 
                ) 
               stl 
             ) 
  ) 
  ;;建立词典，随图保存 
  (vlax-ldata-put "#myaxis" "style" $old_stl) 
  (foreach n $old_stl 
    (setq _name            (car n) 
          e            (cadr n) 
          _styleshx (last n) 
    ) 
    (if 
      (OR (wcmatch _styleshx "*ttf*") 
          (not 
            (findfile (strcat (cdr (assoc 3 (entget (cadr n)))) ".shx")) 
          ) 
          (not 
            (findfile (strcat (cdr (assoc 4 (entget (cadr n)))) ".shx")) 
          ) 
          (wcmatch _styleshx "*pfb") 
      ) 
      (xdrx_setenttodb (cadr n)) 
      (xdrx_modent 3 "gbenor.shx" 4 "gbcbig.shx") 
    ) 
  ) 
  (xdrx_object_regen) 
  (xdrx_sysvar_pop) 
  (xdrx_end) 
  (princ) 
) 
(defun c:resfnt        (/ a oldtxtsty) 
  (setq oldtxtsty (getvar "textstyle")) 
  (setq a (vlax-ldata-get "#myaxis" "style")) 
  (foreach n a 
    (command "-style" 
             (car n) 
             (cadr n) 
             "" 
             "" 
             "" 
             "" 
             "" 
             (if (= oldtxtsty (caar a)) 
               "" 
             ) 
    ) 
    (setq a (cdr a)) 
  ) 
  (command) 
  (vlax-ldata-delete "#myaxis" "style") 
  (setvar "textstyle" oldtxtsty) 
  (princ) 
)

lt_zzy · 发表于 2003-8-19 08:08:22

eachy：
我用得是14与2002，第九贴的程序是不是就执行不了？

leizi_yy · 发表于 2004-6-17 19:27:02

请问：如果我要改成仿宋
呢？？

lt_zzy · 发表于 2004-6-17 20:05:47

你将上面的HZTXT.shx,tjhzd.shx
改成仿宋的字体就行了。

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

[求助] [求助]：文本样式

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

相关帖子

浏览过的版块