ivyej 发表于 2006-5-14 20:04:00

[LISP]求助：帮我改一个展点程序

<P></P>
<P>各位大侠，帮我改下这个展点程序，本来是用来将注记展成点的，可是这个程序里面是注记左下角对齐，我想要中心对齐的。不知道我说的名不明白，我的MSN：<A href="mailto:ivyej11@hotmail" target="_blank" >ivyej11@hotmail</A>，联系我吧。。。谢谢啦。</P>

ivyej 发表于 2006-5-16 14:10:00

请各位帮忙~~

sxyczpylhp 发表于 2010-10-21 22:06:00

<p><font face="Verdana">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;LISP展点程序 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;展1000点：在HP(AMD Athlon64&nbsp; 3000+&nbsp; 256MB)电胶上仅耗时0.142秒； <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;在金利(Geleron(R) CPU 2.40GHz 256MB)电脑上耗时0.882秒 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;数据文件格式为：每一点的数据（点号、X、Y、H）为一行，用逗号或空格作为分隔符，即 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;点号1&nbsp; X1&nbsp; Y1 H1&nbsp;&nbsp; 或者 点号1,&nbsp; X1,&nbsp; Y1, H1 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;点号2&nbsp; X2&nbsp; Y2 H2&nbsp;&nbsp; 或者 点号2,&nbsp; X2,&nbsp; Y2, H2 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;点号3&nbsp; X3&nbsp; Y3 H3&nbsp;&nbsp; 或者 点号3,&nbsp; X3,&nbsp; Y3, H3 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;...... <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;点号n&nbsp; Xn&nbsp; Yn Hn&nbsp;&nbsp; 或者 点号n,&nbsp; Xn,&nbsp; Yn, Hn1 <br/>(defun c:kszd ()<br/>&nbsp; (setq&nbsp;ff&nbsp;&nbsp; (open (getfiled "请选择要展点的数据文件" "" "txt" 2) "r")<br/>&nbsp;fhb&nbsp; nil<br/>&nbsp;t0&nbsp;&nbsp; (getvar "cdate")<br/>&nbsp;cm&nbsp;&nbsp; (getvar "cmdecho")<br/>&nbsp;os&nbsp;&nbsp; (getvar "osmode")<br/>&nbsp;tcm1 "高程注记"<br/>&nbsp;tcm2 "点记"<br/>&nbsp; )<br/>&nbsp; (setvar "cmdecho" 0)<br/>&nbsp; (setvar "osmode" 0)<br/>&nbsp; (if (= (tblsearch "layer" tcm1) nil)<br/>&nbsp;&nbsp;&nbsp; (command "layer" "n" tcm1 "")<br/>&nbsp; )<br/>&nbsp; (if (= (tblsearch "layer" tcm2) nil)<br/>&nbsp;&nbsp;&nbsp; (command "layer" "n" tcm2 "")<br/>&nbsp; )<br/>&nbsp; (setq tap 1)<br/>&nbsp; (while (= tap 1)<br/>&nbsp;&nbsp;&nbsp; (Progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq n&nbsp;1<br/>&nbsp;&nbsp;&nbsp;&nbsp; fhb&nbsp;nil</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (while (&lt; n 2001)<br/>&nbsp;(if (setq zb (read-line ff))<br/>&nbsp;&nbsp; (Progn<br/>&nbsp;&nbsp;&nbsp;&nbsp; (while (vl-string-search "," zb)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq zb (vl-string-subst " " "," zb))<br/>&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq zb&nbsp; (read (strcat "(" zb ")"))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;zb&nbsp; (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string&nbsp; (last zb)));注记高程 <br/>&nbsp;&nbsp;&nbsp; zb&nbsp; (list (list (nth 2 zb) (nth 1 zb))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vl-princ-to-string (car zb))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )&nbsp;&nbsp;&nbsp;;提示：注记点号请用该行 <br/>&nbsp;&nbsp;&nbsp; fhb (append fhb (list zb))<br/>&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq n (+ 1 n))<br/>&nbsp;&nbsp; )<br/>&nbsp;&nbsp; (setq&nbsp;n&nbsp;&nbsp; 2001<br/>&nbsp;&nbsp;tap 0<br/>&nbsp;&nbsp; )<br/>&nbsp;)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq t1 (getvar "cdate"))</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq zb (vl-sort&nbsp;fhb<br/>&nbsp;&nbsp;&nbsp;'(lambda (e1 e2) (&lt; (car (car e1)) (car (car e2))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp; x0 (car (car (car zb)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; x1 (car (car (last zb)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; zb (vl-sort<br/>&nbsp;&nbsp; fhb<br/>&nbsp;&nbsp; '(lambda (e1 e2) (&lt; (cadr (car e1)) (cadr (car e2))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp; y0 (cadr (car (car zb)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; y1 (cadr (car (last zb)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (command "zoom" "w" (list x0 y0) (list x1 y1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq t2 (getvar "cdate"))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (foreach zb fhb<br/>&nbsp;(setq zfc (last zb)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;pt&nbsp; (mapcar '+ (car zb) '(1.5 -1.25));这行改为如下 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt&nbsp; (car zb)<br/>&nbsp;)<br/>&nbsp;(entmake (list '(0 . "TEXT")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '(100 . "AcDbEntity")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '(100 . "AcDbText")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '(62 . 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '(40 . 2.5)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '(50 . 0.0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;(cons 8 tcm1)&nbsp;&nbsp; (cons 1 zfc)&nbsp; (cons 10 pt);这行改为如下 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cons 8 tcm1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cons 1 zfc)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cons 10 (mapcar '+ pt '(1.5 -1.25)))<br/>&nbsp;&nbsp; )<br/>&nbsp;)<br/>&nbsp;(entmake (list '(0 . "POINT")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '(100 . "AcDbEntity")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '(100 . "AcDbPoint")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '(62 . 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cons 8 tcm2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cons 10 pt)<br/>&nbsp;&nbsp; )<br/>&nbsp;)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq t3&nbsp;(getvar "cdate")<br/>&nbsp;&nbsp;&nbsp;&nbsp; dt1&nbsp;(* 1000000 (- t1 t0))<br/>&nbsp;&nbsp;&nbsp;&nbsp; dt2&nbsp;(* 1000000 (- t3 t2))</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (princ (strcat "读入数据共耗时："<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (rtos dt1 2 3)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "秒&nbsp;&nbsp; 展点共耗时"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (rtos dt2 2 3)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "秒"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "展点数："<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (itoa (length fhb))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "个&nbsp; 每展一点耗："<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (rtos (/ dt2 (length fhb)) 2 10)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "秒\n"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq dt3&nbsp;(* 1000000 (- t3 t0))</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (princ (strcat "共耗时："<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (rtos dt3 2 3)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "秒\n"</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp; )<br/>&nbsp; (setvar "cmdecho" cm)<br/>&nbsp; (setvar "osmode" os)<br/>&nbsp; (close ff)<br/>&nbsp; (princ)<br/>)</font></p>

sxyczpylhp 发表于 2010-10-21 22:09:00

<p>这是改进的展点程序，要不展点过20000时太慢</p>
<p>SXYCZPYLHP山西榆次物测院人用半月试验成！！</p>

sxyczpylhp 发表于 2010-10-21 22:11:00

改进的原理是：分而治之，各个击破，分块解决！！！有同仁欢迎商讨！！

sxyczpylhp 发表于 2010-10-21 22:13:00

本人邮箱<a href="mailto:sxyczpylhp@126.com">sxyczpylhp@126.com</a>

sxyczpylhp 发表于 2010-10-21 22:14:00

<p>20101016编成</p>
<p>&nbsp;</p>

chenxi665 发表于 2013-1-17 10:35:48

skg123 发表于 2013-6-5 23:29:43

sxyczpylhp 发表于 2010-10-21 22:06 static/image/common/back.gif
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;LISP展点程序 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;展1000点：在HP(AMD Athlon ...

标注的是点号，不是高程

太行隐士1992 发表于 2015-3-31 21:48:37

sxyczpylhp 发表于 2010-10-21 22:09 static/image/common/back.gif
这是改进的展点程序，要不展点过20000时太慢
SXYCZPYLHP山西榆次物测院人用半月试验成！！

山西省煤炭地质物探测绘院？
页: [1]
查看完整版本: [LISP]求助：帮我改一个展点程序