[LISP程序]：坐标点展绘

ch3028

这是开始学Lisp学习时写的，用来展绘坐标点并记点号或者高程等字符注记，在Acad 2000上运行。运行速度不快（约10点/s）
加载程序后，输入“zd”命令就可运行。
数据格式：
第一行为总点数
第二行是：1点 点名，1点 编码，1点 Y（东）坐标，1点 X（北）坐标，1点 高程
.........................
第n行是:n-1点 点名，n-1点 编码，n-1点 Y（东）坐标，n-1点 X（北）坐标，n-1点 高程
例：4
1,f1,497728.882,86448.407,14.267
2,dx,497726.893,86454.135,14.575
3,gcd,497720.004,86453.003,13.654
4,dl,497728.950,86454.895,14.513
数据文件扩展名为dat（*.dat）
*******************************************************************
;;;本程序用于坐标点展。数据格式沿用南方仪器公司cass的格式
;;;点名，编码，Y（东）坐标，X（北）坐标，(Z)高程
;;;如果要展代码、高程请将(command "zoom" "e")中的"e"改成"e2"或者是""h""

2. 
   
3. (defun C:zd (/ fi b n e e2 y x h n2 p1 p2)
   
4. ;;;  (print
   
5. ;;;    "\n 您好！欢迎您！这里是展绘点号程序，确认后，选择数据文件\n"
   
6. ;;;    )
   
7.   (setq        fi (open
   
8.              (getfiled "请选择数据文件" "" "dat" 8)
   
9.              "r"
   
10.              )
    
11.         )
    
12.   (setq        b
    
13.          (read
    
14.            (read-line fi)
    
15.            )
    
16.         )
    
17.   (setq n 1)
    
18.   (command "layer" "s" "0" "")
    
19. ;;;  (setvar "AutoSnap" 0)
    
20.   (while (<= n b)
    
21.     (setq d
    
22.            (read-line fi)
    
23.           )
    
24. ;;;读取点号( 数据格式是：点号，代码，Y坐标，X坐标，高程)
    
25.     (setq start-pos (vl-string-search "," d 0))
    
26.     (setq e
    
27.            (substr d 1 start-pos)
    
28.           )
    
29. ;;;读码
    
30.     (setq n2 (1+ start-pos))
    
31.     (setq start-pos (vl-string-search "," d n2))
    
32.     (setq e2
    
33.            (substr d (1+ n2) (- start-pos n2))
    
34.           )
    
35. ;;;读取横坐标
    
36.     (setq n2 (1+ start-pos))
    
37.     (setq start-pos (vl-string-search "," d n2))
    
38.     (setq y
    
39.            (substr d (1+ n2) (- start-pos n2))
    
40.           )
    
41. ;;;读取纵坐标
    
42.     (setq n2 (1+ start-pos))
    
43.     (setq start-pos (vl-string-search "," d n2))
    
44.     (setq x
    
45.            (substr d (1+ n2) (- start-pos n2))
    
46.           )
    
47. ;;;读取高程
    
48.     (setq n2 (1+ start-pos))
    
49.     (setq start-pos (vl-string-search "," d n2))
    
50.     (setq h
    
51.            (substr d (1+ n2))
    
52.           )
    
53. ;;; 进行展点   
    
54.     (setq y1 (read y))
    
55.     (setq x1 (read x))
    
56.     (setq h1 (read h))
    
57.     (setq p1 (list y1 x1 h1)
    
58.           p2 (list (+ y1 0.5) (- x1 0.75))
    
59.           )
    
60.     (command "point" p1)
    
61.     (command "text" p2 1 0 e)
    
62.     (setq n (1+ n)
    
63.           )
    
64.     )
    
65.   (close fi)
    
66.   (command "zoom" "e")
    
67. ;;;  (setvar "AutoSnap" 1)
    
68.   )
    

<br /> (defun C:zd (/ fi b n e e2 y x h n2 p1 p2)<br /> ;;;  (print<br /> ;;;    "\n 您好！欢迎您！这里是展绘点号程序，确认后，选择数据文件\n"<br /> ;;;    )<br />   (setq        fi (open<br />              (getfiled "请选择数据文件" "" "dat" 8)<br />              "r"<br />              )<br />         )<br />   (setq        b<br />          (read<br />            (read-line fi)<br />            )<br />         )<br />   (setq n 1)<br />   (command "layer" "s" "0" "")<br /> ;;;  (setvar "AutoSnap" 0)<br />   (while (<= n b)<br />     (setq d<br />            (read-line fi)<br />           )<br /> ;;;读取点号( 数据格式是：点号，代码，Y坐标，X坐标，高程)<br />     (setq start-pos (vl-string-search "," d 0))<br />     (setq e<br />            (substr d 1 start-pos)<br />           )<br /> ;;;读码<br />     (setq n2 (1+ start-pos))<br />     (setq start-pos (vl-string-search "," d n2))<br />     (setq e2<br />            (substr d (1+ n2) (- start-pos n2))<br />           )<br /> ;;;读取横坐标<br />     (setq n2 (1+ start-pos))<br />     (setq start-pos (vl-string-search "," d n2))<br />     (setq y<br />            (substr d (1+ n2) (- start-pos n2))<br />           )<br /> ;;;读取纵坐标<br />     (setq n2 (1+ start-pos))<br />     (setq start-pos (vl-string-search "," d n2))<br />     (setq x<br />            (substr d (1+ n2) (- start-pos n2))<br />           )<br /> ;;;读取高程<br />     (setq n2 (1+ start-pos))<br />     (setq start-pos (vl-string-search "," d n2))<br />     (setq h<br />            (substr d (1+ n2))<br />           )<br /> ;;; 进行展点   <br />     (setq y1 (read y))<br />     (setq x1 (read x))<br />     (setq h1 (read h))<br />     (setq p1 (list y1 x1 h1)<br />           p2 (list (+ y1 0.5) (- x1 0.75))<br />           )<br />     (command "point" p1)<br />     (command "text" p2 1 0 e)<br />     (setq n (1+ n)<br />           )<br />     )<br />   (close fi)<br />   (command "zoom" "e")<br /> ;;;  (setvar "AutoSnap" 1)<br />   )<br />

*****************************************************************************
请大家指教.