[原创]CASS格式文件报表（CAD）输出

<P><FONT color=#ff0000><STRONG><EM>N年前编的无数个小程序中的一个，现在已用不上了，但对从事GIS前端数据采集的一些朋友可能还有用，有兴趣的也可以一用！！！太简单了，这里就不多说了！！！希望对你的工作有所帮助！！！有时间的时候陆续再帖一些，希望可以为需要的朋友提供些许帮助！！！</EM></STRONG></FONT></P>
<P>;-----------------------------读一个字符串-------------------------------<br>(defun READSTR()<br>    (SETQ TP (READ-CHAR F1))<br>    (IF (/= TP NIL) (SETQ P (CHR TP)))<br>    (SETQ STR "")<br>    (while (AND (/= P  ",") (/= P (CHR 10)))<br>           (IF (/= P " ") (SETQ STR (STRCAT STR P)))<br>           (SETQ P (CHR (READ-CHAR F1)))<br>          )<br>     )<br>;-----------------------------读一行数据并赋值--------------------------<br>(DEFUN TXYH()<br>       (READSTR)<br>       (SETQ DM STR)<br>       (READSTR)<br>       (SETQ CO STR)<br>       (READSTR)<br>       (SETQ YY STR)<br>       (READSTR)<br>       (SETQ XX STR)<br>       (READSTR)<br>       (SETQ HH STR)<br>)<br>;-------------------------------输出精度等级-----------------------------<br>(defun DJ(j)<br>       (cond ((= j "1") (command "Text" "j" "bc" (list (+ xa 24.5) ya) 3 0 "Ⅰ级"))<br>            ((= j "2") (command "Text" "j" "bc" (list (+ xa 24.5) ya) 3 0 "Ⅱ级"))<br>            ((= j "3") (command "Text" "j" "bc" (list (+ xa 24.5) ya) 3 0 "Ⅲ级"))<br>　　　　　　((= j "4") (command "Text" "j" "bc" (list (+ xa 24.5) ya) 3 0 "图根"))<br>            ((= j "11") (command "Text" "j" "bc" (list (+ xa 24.5) ya) 3 0 "Ⅰ等"))<br>            ((= j "12") (command "Text" "j" "bc" (list (+ xa 24.5) ya) 3 0 "Ⅱ等"))<br>　　　　　　((= j "13") (command "Text" "j" "bc" (list (+ xa 24.5) ya) 3 0 "Ⅲ等"))<br>　　　　　　((= j "14") (command "Text" "j" "bc" (list (+ xa 24.5) ya) 3 0 "Ⅳ等"))<br>         )<br>)</P>
<P>;--------------------------数据输出主程序jfh40()---------------------------------------<br>(TRACE JFH)<br>(defun C:jfh40()<br>    (setvar "cmdecho" 0)<br>    (setvar "osmode" 0)<br>    (COMMAND "-STYLE" "TTST" "SIMSUN.TTF" 0 0.8 0 "N" "N""")<br>    (setq f0 (getfiled "请选择输出坐标文件" "c:/jfhdwg/" "dat" 8))<br>    (setq f1 (open f0 "r"))<br>    (setq N  (read (read-line f1)))<br>    (setq stn (getpoint "请输入表格插入点:"))<br>    (setq x0 (car stn))<br>    (setq y0 (nth 1 stn))<br>    (setq pt (grread 0))<br>    (setq pt1 (car pt))<br>    (setq xa x0)<br>    (setq i 0)<br>    (while (< i N)</P>
<P>           (setq ya (+ y0 156))</P>
<P><STRONG><EM><FONT color=#f70909>;;把下面蓝色部分换成CAB.dwg（见附件）文件所在位置即可</FONT><br></EM></STRONG>           (command "insert" "<FONT color=#1111ee><STRONG><EM><U>d:\\programs\\bak\\cgb</U></EM></STRONG></FONT>" (list xa y0) 1 1 0"")</P>
<P>           (while(>= ya (+ y0 3))<br>                 (TXYH)<br>                 (command "Text" "j" "bc" (list (+ xa 9.5) ya) 3 0 DM)<br>                 (setq j CO)<br>                 (DJ j)<br>                 (command "Text" "j" "bc"  (list (+ xa 91) ya) 3 0 YY)<br>                 (command "Text" "j" "bc"  (list (+ xa 64.5) ya) 3 0 XX)<br>                 (command "Text"  "j" "br" (list (+ xa 123) ya) 3 0 HH)<br>          (setq ya (- ya 9))<br>                 (setq i (+ i 1))<br>        )<br>           (setq xa (+ xa 190))<br>       )<br>    (close f1)<br>    (command "zoom" "e")<br>)</P><br><a href="attachment/2005-6/20056720365468137.rar">2005-6/20056720365468137.rar</a><br>

good

<P>谢谢！！！</P>
<P>支持！</P>