liminnet
发表于 2008-8-21 14:12:00
caoyin
发表于 2008-8-21 14:32:00
<p>不考虑实数的精度</p><p>(read (vl-string-translate "( )" "\",\"" (vl-princ-to-string '(0.2 -0.02 2.35 -0.025))))</p>
liminnet
发表于 2008-8-21 15:07:00
liminnet
发表于 2008-8-21 17:05:00
liminnet
发表于 2008-8-21 17:25:00
caoyin
发表于 2008-8-21 18:05:00
本帖最后由 作者 于 2008-8-21 18:07:35 编辑 <br /><br /> <p>(defun lindataout (filediretory)<br/> ;;<font color="#ff0000">(setvar "cmdecho" 0);;没有用到command可以忽略</font><font color="#ff0000"><br/></font> (if (= filediretory t) (setq filediretory (getvar "dwgprefix")) <font color="#ff3300">filediretory</font>)<br/> (setq nm (open (strcat filediretory "线型文件.lin") "w"))<br/> (princ " " nm)<br/> (close nm)<br/> ;;<font color="#ff0000">(vl-load-com)没有用到</font><font color="#000000"><font color="#ff0000">ActiveX可以忽略</font><br/> (command "purge" "all" "*" "N")<br/> (command "purge" "all" "*" "N")<br/> (if (= filediretory t) (setq filediretory (getvar "dwgprefix")) <font color="#ff3300">filediretory</font>)<br/> (setq nm (open (strcat filediretory "线型文件.lin") "a"))<br/></font><font color="#0033ff"> (princ "\n" nm)<br/> (princ "; Linetypes exported by LinOut.lsp Version 2.0" nm)<br/> (princ "\n;" nm)<br/> (princ "\n; by Koyote - 方中集团－－工程管理部：李敏" nm)<br/> (princ "\n;" nm)<br/> (princ "\n" nm)</font></p><p> ;;蓝色部分可缩写为</p><p><font color="#c4c43c"> (princ "\n; Linetypes exported by LinOut.lsp Version 2.0\n;<br/> \n; by Koyote - 方中集团－－工程管理部：李敏\n;\n" nm)</font></p><p><font color="#000000"><br/> (setq <font color="#cc00ff">txtsty</font> nil txtlst (list))<br/> (setq <font color="#ff00ff">txtsty</font> (tblnext "LTYPE" t))<br/> (setq <font color="#ff00ff">txtsty</font> (tblnext "LTYPE"));;紫色部分只有最后一个有效啊<br/> (setq name (cdr(assoc 2 txtsty)))<br/> (setq name1 nil)<br/>(while (/= name name1)<br/> (setq name (cdr(assoc 2 txtsty)))<br/>(if (/= name "CONTINUOUS")<br/> (progn<br/> (setq ts (cdr(assoc 3 txtsty)))<br/> (setq ltdata (entget (tblobjname "ltype" name)))<br/> (setq ltlst (mapcar (function(lambda(x) (cDr x))) (vl-remove-if-not '(lambda(x) (= 49 (car x))) ltdata)))<br/> (setq ltlst (read (vl-string-translate "( )" "\",\"" (vl-princ-to-string ltlst))))<br/> (princ "*" nm)<br/> (princ name nm)<br/> (princ "," nm)<br/> (princ ts nm) <br/> (princ "\nA," nm)<br/> (princ ltlst nm)<br/> (princ "\n" nm)<br/> (setq txtsty (tblnext "LTYPE"))<br/> (if(/= txtsty nil)<br/> (setq name1 (cdr(assoc 2 txtsty)))<br/> );End_if <br/> );End_progn<br/>);End_if <br/>);End_while<br/>(close nm)<br/> (setvar "cmdecho" 1)<br/>(princ)<br/>)</font></p>
lolanda
发表于 2008-8-21 21:20:00
哈哈，楼上真细心，学习了！
liminnet
发表于 2008-8-22 08:26:00
页:
[1]