liminnet
发表于 2009-4-17 08:47:00
userzhl
发表于 2009-4-17 08:51:00
(defun fdzx (/ sty1 sty2 first tab sm1 sm2)<br/> (setq first T)<br/> (setq tab '())<br/> (setq stytab '())<br/> (setq sty_zh '())<br/> (while (setq sty1 (tblnext "style" first)) ;搜索图中字型 <br/> (if (= first T)<br/> (setq first nil)<br/> )<br/> (if (/= sty1 nil)<br/> (progn<br/> (setq tab (cons sty1 tab))<br/> (setq sty1 (nth 0 tab))<br/> (setq sty2 (dxf 2 sty1)) ;字型名称<br/> (setq sm1 (dxf 3 sty1)) ;所用小字体文件的名称<br/> (setq sm2 (dxf 4 sty1)) ;所用大字体文件的名称<br/> (setq stytab (cons sty2 stytab))<br/> (if (and sm2 (/= sm2 ""))<br/> (setq sty_zh (cons (strcat sty2 ":<" sm1 "," sm2 ">") sty_zh))<br/> (setq sty_zh (cons (strcat sty2 ":<" sm1 ">") sty_zh))<br/> )<br/> )<br/> )<br/> )<br/>)
liminnet
发表于 2009-4-17 10:29:00
liminnet
发表于 2009-4-17 17:31:00
userzhl
发表于 2009-4-17 20:42:00
本帖最后由 作者 于 2009-4-17 20:59:00 编辑 <br /><br /> <p><strong><font face="Verdana" color="#61b713">liminnet</font></strong>,可不可以把源码发一份给我?</p><p>user-zhl@163.com</p>
userzhl
发表于 2009-4-19 11:10:00
<p>(defun c:tt (/ show_list sub_unifont sub_bigfont ok_remstyle $VALUE BIGFONT_LST BIGNAME DCLNAME DCL_ID FILEN NEWSTR OLDSTR TEMPNAME UNIFONT_LST UNINAME)</p><p>(defun show_list (key newlist)<br/> (start_list key)<br/> (mapcar 'add_list newlist)<br/> (end_list)<br/>)</p><p>(defun sub_unifont (vvs)<br/>(set_tile "bigfont" "(setq $value \"1\")")<br/>)</p><p>(defun sub_bigfont (vvs)<br/> (set_tile "bigfont" "(setq $value \"0\")")<br/>)</p><p>(defun ok_remstyle ()<br/> (setq uniname (nth (atoi (get_tile "unifont")) unifont_lst))<br/> (setq bigname (nth (atoi (get_tile "bigfont")) bigfont_lst))<br/> (alert uniname) (alert bigname)<br/>)</p><p>(setq dclname <br/>(cond <br/>((setq tempname (vl-filename-mktemp "ko-dcl-tmp.dcl") filen (open tempname "w")) <br/>(foreach stream <br/>'( <br/>"fontrem:dialog{\n"<br/>" label=\"文字样式替换\";\n"<br/>" :text{ label=\"发现N个文字样式缺少字体!!\"; alignment=centered; color=\"7\";}\n"<br/>" :boxed_column{\n"<br/>" label=\"请选择替换的字体\";\n"<br/>" :row{\n"<br/>" :text{ label=\"SHX字体：\";}\n"<br/>" :text{ label=\"大字体：\";}\n"<br/>" }\n"<br/>" :row{\n"<br/>" :popup_list{ key=\"unifont\";edit_width=18;}\n"<br/>" :popup_list{ key=\"bigfont\"; edit_width=18;}\n"<br/>" }\n"<br/>" :toggle{label=\"使用大字体\";key=\"ubigfont\"; value=\"1\";}\n"<br/>" }\n"<br/>" spacer_1;\n"<br/>" ok_cancel;\n"<br/>"}\n"<br/>"\n"<br/>"\n"<br/>"\n"<br/>"\n"<br/>)<br/>(princ stream filen)<br/>) <br/>(close filen)<br/>tempname<br/>)))<br/>(setq unifont_lst '("a" "b" "c"))<br/>(setq bigfont_lst '("1" "2" "s5" "3" "4" "5" "6" "7" "8" "9" "10"))<br/>(setq dcl_id (load_dialog tempname))<br/>(if (not (new_dialog "fontrem" dcl_id "")) (progn (alert "dcl对话框加载失败.")(exit)))<br/>(show_list "unifont" unifont_lst)<br/>(show_list "bigfont" bigfont_lst)<br/>(action_tile "unifont" "(sub_unifont $value)")<br/>(action_tile "bigfont" "(sub_bigfont $value)")<br/>(action_tile "accept" "(ok_remstyle) (done_dialog)")<br/>(start_dialog)<br/>(unload_dialog dcl_id)<br/>(vl-file-delete dclname) <br/>)</p><p><font face="Verdana" color="#61b713"><strong>liminnet</strong><font color="#000000">的程序,但还需要完善,哪位高手帮忙完善一下?</font></font></p>
liminnet
发表于 2009-4-20 09:03:00
userzhl
发表于 2009-4-20 11:02:00
<p><strong><font face="Verdana" color="#61b713">liminnet</font></strong>,可否发一份给我,让我学习一下? <a href="mailto:user-zhl@163.com">user-zhl@163.com</a> 谢谢!</p>
liminnet
发表于 2009-4-20 12:43:00
liminnet
发表于 2009-4-20 13:14:00