andyding 发表于 2006-4-28 22:20:00

请Spring大侠及各路高手帮忙。

<P>q</P>
<P>请各位大侠看看，这个程序是Spring大侠写的，用来新建层的，但是新建层时，DAT文件（DAT文件上传不了，我改名为TXT了）内定制的线型不能自动赋值，必须先加载好线型才能OK。请各位大侠帮忙解决。</P>
<P>谢谢</P>

HuaiYu 发表于 2006-4-29 12:05:00

<P>增加了一个检查函数在里面，判断若没有则加载</P>
<P>;;;功能 : 创建图层<BR>;;;_____________________________________________________<BR>(defun c:nl (/ fi makelayer_list n makelayer layer_name&nbsp;layer_linetype layer_color<BR>&nbsp;&nbsp;&nbsp;&nbsp; )<BR>;;;_______________________________________________________<BR>;;;取得图层列表<BR>&nbsp; (defun GET_FILE_MAKELAYER (fi / fil pe fel)<BR>&nbsp;&nbsp;&nbsp; (setq makelayer_list nil)<BR>&nbsp;&nbsp;&nbsp; (if&nbsp;(findfile fi)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<BR>&nbsp;(setq fil (findfile fi))<BR>&nbsp;(setq pe (open fil "r"))<BR>&nbsp;(while (setq fel (read-line pe))<BR>&nbsp;&nbsp; (setq makelayer_list (cons fel makelayer_list))<BR>&nbsp;)<BR>&nbsp;(close pe)<BR>&nbsp;(setq makelayer_list (cdr (reverse makelayer_list)))<BR>&nbsp;;根据文本的内容而定<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>&nbsp; (GET_FILE_MAKELAYER "d:\\txt.txt")<BR>&nbsp; ;;_____________________________________________________<BR>&nbsp; ;;&nbsp;检查是否有这个线型，若没有则加载&nbsp;&nbsp;.<BR>&nbsp; (defun checkLinetype (Linetype)<BR>&nbsp;&nbsp;&nbsp; (vl-load-com)<BR>&nbsp;&nbsp;&nbsp; (setq Linetypes (vla-get-linetypes (vla-get-activeDocument (vlax-get-acad-object))))<BR>&nbsp;&nbsp;&nbsp; (vl-catch-all-apply 'vla-load (list Linetype "ACAD.LIN"))<BR>&nbsp; )<BR>;;;_______________________________________________________<BR>&nbsp; (setq n 0)<BR>&nbsp; (while (&gt; (length makelayer_list) n)<BR>&nbsp;&nbsp;&nbsp; (setq makelayer (read (strcat "(" (nth n makelayer_list) ")")))<BR>&nbsp;&nbsp;&nbsp; (setq layer_name (nth 0 makelayer)) ;图层名<BR>&nbsp;&nbsp;&nbsp; (setq layer_linetype (nth 1 makelayer)) ;图层型<BR>&nbsp;&nbsp;&nbsp; (checkLinetype layer_linetype);&nbsp;The new add function to check there is or not exist the linetype&nbsp;.<BR>&nbsp;&nbsp;&nbsp; (setq layer_color (nth 2 makelayer)) ;图层颜色<BR>&nbsp;&nbsp;&nbsp; (setq layer_polt (nth 3 makelayer)) ;打印<BR>&nbsp;&nbsp;&nbsp; (entmake<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (list<BR>&nbsp;'(0 . "LAYER")<BR>&nbsp;'(100 . "AcDbSymbolTableRecord")<BR>&nbsp;'(100 . "AcDbLayerTableRecord")<BR>&nbsp;'(70 . 0)<BR>&nbsp;(cons 6 layer_linetype) ;线型<BR>&nbsp;(cons 62 layer_color) ;颜色<BR>&nbsp;(cons 2 layer_name) ;图层名<BR>&nbsp;(cons 290 layer_polt)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp; (setq n (1+ n))<BR>&nbsp; )<BR>&nbsp; (princ "\nMould Layer Create OK ")<BR>&nbsp; (princ)<BR>)<BR>;;;_______________________________________________________<BR></P>

andyding 发表于 2006-4-29 14:52:00

多谢HuaiYu大侠，我试了下，线型还是不能自动设置。

HuaiYu 发表于 2006-4-29 17:19:00

不好意思，我把这句给改了 (GET_FILE_MAKELAYER "d:\\txt.txt")<BR>你把这里给改成你电脑上的路径再试试吧

andyding 发表于 2006-4-29 18:52:00

<P>我是改好了才试的。</P>

xxsheng 发表于 2006-4-29 20:40:00

本帖最后由 作者 于 2006-4-29 21:27:26 编辑 <br /><br /> &nbsp;;;&nbsp;检查是否有这个线型，若没有则加载&nbsp;&nbsp;.<BR>&nbsp; (defun checkLinetype (Linetype)<BR>&nbsp;&nbsp;&nbsp; (vl-load-com)<BR>&nbsp;&nbsp;&nbsp; (setq Linetypes (vla-get-linetypes (vla-get-activeDocument (vlax-get-acad-object))))<BR>&nbsp;&nbsp;&nbsp; (vl-catch-all-apply 'vla-load (list Linetype "ACAD.LIN"))<BR>&nbsp; )<BR>我是看不出来到底哪里有检查了.而且,,,'vla-load 后面没有对象??用法也是错误,

xxsheng 发表于 2006-4-29 21:37:00

<P>(vl-catch-all-apply 'vla-load (list Linetype "ACAD.LIN"))</P>
<P>改下,,,</P>
<P>(vl-catch-all-apply 'vla-load (list&nbsp; Linetypes&nbsp;Linetype "ACAD.LIN"))</P>

andyding 发表于 2006-4-30 07:44:00

多谢<A name=10330><FONT color=#000066><B>xxsheng</B></FONT></A>、<A name=10293><FONT color=#000066><B>HuaiYu</B></FONT></A>大侠。已经OK了。

HuaiYu 发表于 2006-4-30 23:05:00

<P>汗，函数写错了.态度还是不够严谨的啊, test 的时候确实是 test 错了。见笑了....</P>
页: [1]
查看完整版本: 请Spring大侠及各路高手帮忙。