|
经常会遇到外来的图纸在打开时，缺少形文件和显示不全或显示问号等的情形，很是恼火。而且本人有一个癖好，就是喜欢用自己的形文件。所以在看图之前一定要将字体的形文件改为自己的形文件，不然就闹心、不舒服，无法进入状态。但改起来也是比较繁琐，网上找来找去也没找到一个能用的，不是加密就是有时间限制。一狠心，自己搞一个。经过四天的折磨，终于搞出来一个可用的程序。虽然不是特别完善，但自己就这水平了，诸君莫笑。当然，哪位大神能够抽出宝贵时间修改使之完善，本人将不胜感激。好了，闲言少叙，下面就程序逐条解释说明一下，以便理解本人的意图。 (defun c:chst();定义函数change style各取前两个字母 (setvar "CMDECHO" 0);使程序在执行过程中不在屏幕上显示步骤，取消的话，可用于调试程序 ;到底在哪一步出问题的。 (prompt " 注意：无论选择哪种字体，都必须保证该字体在系统中存在(AutoCAD或者Windows)!\n") (initget "0 1");设定关键字，下面紧跟的一句只能输入引号内的关键字0和1，当然可以设置多个。 ;但需要注意的是只能是单个的字符（数字或字母）。 (setq c10 (getkword " 使用TrueType字体的样式是否替换? (0:否 1:是) <0>: "));取关键字 (if (null c10) (setq c1 0) (setq c1 (atoi c10)));如果关键字为空（默认值），设c1=0，否则将关键字 ;转换为整数并赋值给c1 (initget "0 1") (setq c0 (getkword " 未使用大字体的样式是否使用大字体? (0:否 1:是) <0>: ")) (if (null c20) (setq c2 0) (setq c2 (atoi c20)));同上，c2赋值 (setq sa1 (getstring " 形字体文件名 <simplex1>: "));取shx形字体名。 (if (= sa1 "") (setq sa "simplex1.shx") (setq sa (strcat sa1 "." "shx")));如果为空，则为默认值，否则赋值并加上后缀。 (setq sb1 (getstring " 大字体文件名 <sedin> : ")) (if (= sb1 "") (setq sb "sedin.shx") (setq sb (strcat sb1 "." "shx")));同上，赋值。 (setq sb (strcase (strcat sa "," sb) T));将sa和sb合并，并全部改为小写字符。 (setq i 1 j 1 n 1);设置循环计数变量和起初始值 (while (<= i 1000);总的循环计数，言外之意就是枚举字体样式名，但我没找更简捷的办法只好 ;设一较大的范围，以囊括可能的数量，也许设为256更合适，但没关系，只要下一句返回值 ;等于NIL，就退出了。希望大神能指点这里。 (setq tba (tblnext "style"));枚举字体样式名，得到该字体样式名的数据表，指针返回下一个样式名。 ;表是CAD数据保存的基本形式，字体样式名数据表，一共十项，具体如下，每对括号内为一组， ;从0开始计数。 ;命令: (tblnext "style") ;((0 . "STYLE") (2 . "gpshz") (70 . 0) (40 . 0.0) (41 . 0.8) (50 . 0.0) (71 . 0) (42 . 5.0) (3 . "romans.shx") (4 . "hztxt.shx")) ;即0组(0 . "STYLE")，1组(2 . "gpshz")，2组(70 . 0)，3组(40 . 0.0)，4组(41 . 0.8)，5组(50 . 0.0)，6组(71 . 0)， ;7组(42 . 5.0)，8组(3 . "romans.shx")，9组(4 . "hztxt.shx") (if (/= tba NIL);返回值不为NIL，进入判断体执行语句，否则设i=1001退出循环 (progn;多语句执行符号 (setq tb1 (nth 1 tba) st1 (cdr tb1);取表的第1项，这也是一个两项的表，将表的第2项 ;（字体样式名）赋值给st1 tb8 (nth 8 tba) st8 (cdr tb8);取表的第8项得到表，并将表的第2项赋值给st8 tb9 (nth 9 tba) st9 (cdr tb9);同st8 ) (if (and (/= st8 "sedin1.shx") (/= st9 "sedin.shx"));如果st8和st9都不等于这两种字体， ;进入判断体执行下一步。之所以设置这多余的一步，是因为公司的图签中文字采用这两种字体， ;不想因为替换导致图签变化，如果贵公司采用其他字体可以修改赋值，或者干脆取消该语句删除 ;图签，图形整理完成后再插入图签 (progn (if (/= st8 "") (setq sc (strcase (substr st8 (- (strlen st8) 2) 3)));如果st8不为空，则 ;取字形文件的扩展名，并赋值给sc (progn (command "-style" st1 sb "" "" "" "" "" "" \r) (setq n (+ n 1)));否则执行style命令， ;修改字体形文件名（改为sb），并记录修改个数。 ) (cond;进入条件判断，罗列sc的各种情况，执行相应的改写和替换。并记录个数。这是 ;所附图中出现的各种情形，当然可以追加。 ((= sc "SHX") (if (/= st9 "") (progn (command "-style" st1 sb "" "" "" "" "" "" \r) (setq n (+ n 1)))) (if (= st9 "") (if (= c2 0) (progn (command "-style" st1 sa "" "" "" "" "" "" \r) (setq n (+ n 1)))) (if (= c2 1) (progn (command "-style" st1 sb "" "" "" "" "" "" \r) (setq n (+ n 1)))) ) ) ((= sc "TTF") (if (= c1 1) (progn (command "-style" st1 sb "" "" "" "" "" "" \r) (setq n (+ n 1)))) ) ((and (/= sc "SHX") (/= sc "TTF")) (if (/= st9 "") (progn (command "-style" st1 sb "" "" "" "" "" "" \r) (setq n (+ n 1)))) (if (= st9 "") (progn (command "-style" st1 sa "" "" "" "" "" "" \r) (setq n (+ n 1)))) ) ) ) ) (setq i (+ i 1) j (+ j 1));设置执行次数 ) (setq i 1001);当tba=NIL时，设置跳转出循环 ) ) (prompt (strcat " 共计 " (itoa j) " 种字体样式，改变了其中的 " (itoa n) " 种。\n")) (command "-purge" "a" "*" "n" \r);清理无用的东西，块、字体；层、线型等 (command "zoom" "e");图形最大化 (tblnext "style" T);回调指针到起始位置。 (princ) ) 各位大神给看看，不吝赐教。 | 
窥视卡
雷达卡
发表于 2015-1-18 14:29:19
提升卡
置顶卡
沉默卡
喧嚣卡
变色卡
抢沙发
千斤顶
显身卡
楼主
发表于 2015-1-18 17:31:33
发表于 2015-1-19 03:13:48
发表于 2015-1-19 07:45:31
发表于 2015-10-14 12:20:59
发表于 2015-11-18 19:36:52
