[LISP程序]：发个刚刚编好的横断面地面线绘图程序,求建议.

falconry

先感谢一下fylinwater和xyp1964两位前辈帮了我不小的忙
这个程序是根据纬地横断面测量资料来画横断面测量图的,要用一个hdm.txt测量文件才能用

(DEFUN C:0 (/ wj zh zh1 zh2 z y nz ny p px py px1 py1 px2 py2 temp)
(SETQ wj (OPEN "f:\\autolisp\\hdm.TXT" "r"))
(setq p  (getpoint"选择绘图基点"))
(while (= 1 1)
(SETQ zh (atof (READ-LINE wj))
       z  (read (strcat "("(READ-LINE wj)")"))
       nz (length z)
       y  (read (strcat "("(READ-LINE wj)")"))
       ny (length y)
       px (nth 0 p)
       py (nth 1 p)
       p  (list px (+ py 4))
)

  
(command "line" (list px (+ py 1)) (list px (- py 1)) "")    ;画中心线

          
(setq zh1 (fix (/ zh 1000))
       zh  (- zh (* zh1 1000))
)
(cond
   ((> zh 99.9995) (setq zh2 (rtos zh 2 3)))
   ((< zh 9.9995)  (setq zh2 (strcat "00" (rtos zh 2 3))))
   ((< zh 99.9995) (setq zh2 (strcat "0" (rtos zh 2 3))))
)
  
(setq zh (strcat "K" (rtos zh1 2 0) "+" zh2))
(command "text" "j" "m" (list px (- py 1.6)) 0.4 0 zh)       ;标桩号

  
(setq temp 1                                                 ;画地面线
       px1 px
       py1 py
)
  (while (> ny 2)
   (setq px2 (+ px (nth temp y))
         py2 (+ py (nth (+ temp 1) y))
   )
   (command "line" (list px1 py1) (list px2 py2) "")
   (setq ny (- ny 2)
         temp (+ temp 2)
         px1 px2
         py1 py2
   )
)
  
(setq   temp 1
         px1 px
         py1 py
)
  (while (> nz 2)
   (setq px2 (- px (nth temp z))
         py2 (+ py (nth (+ temp 1) z))
   )
   (command "line" (list px1 py1) (list px2 py2) "")
   (setq nz (- nz 2)
         temp (+ temp 2)
         px1 px2
         py1 py2
   )
)

  
;(command "pline" p
;                  (list (+ px (nth 1 z)) (+ py (nth 2 z)))
;                  (list (+ px (nth 3 z)) (+ py (nth 4 z)))
;                  (list (+ px (nth 5 z)) (+ py (nth 6 z)))
;                  (list (+ px (nth 7 z)) (+ py (nth 8 z)))
;                  (list (+ px (nth 9 z)) (+ py (nth 10 z)))
;                  ""
; )
      

)
(close wj)
)

有些图层线型设置什么的没有放进去,感觉用处不是太大了.
感觉程序有几个不足,一个是它是个死循环,读到文件结束时出错了于是退出,不知有没什么完美的方法解决;另一个是我想不出怎么用"pline"来画地面线,就是后面注释里的那一段,想不出该怎么循环才好.求一下各位的建议.
谢谢了!


顶一下,没人给点建议么?

xyp1964

这样吧：

2. [FONT=courier new](load "xyp_lib")
   
3. ;|加载通用函数(可在签名栏直接下载)
   
4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
5. 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
   
6. 1.在acad.lsp中增加(load"xyp_lib")
   
7. 2.在每个程序内增加(load"xyp_lib")
   
8. 3.在command下，输入(load"xyp_lib")
   
9. 4.在菜单.mnl中增加(load"xyp_lib")
   
10. 5.将xyp_lib.vlx文件直接拽到cad屏幕
    
11. [COLOR=red] ★通用函数下载地址：[/COLOR][url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]|;
    
12. 
    
13. (DEFUN C:test (/ wj zh zh1 zh2 z y nz ny p px py px1 py1 px2 py2 temp)
    
14.   (CMDLA0)
    
15.   (jzhz)
    
16.   (SETQ        wj (OPEN (getfiled "坐标数据文件(txt)" "" "txt" 2) "r")
    
17.         p  (getpoint "选择绘图基点")
    
18.   )
    
19.   (while (setq ptt (READ-LINE wj))
    
20.     (SETQ zh (atof ptt)
    
21.           z  (read (strcat "(" (READ-LINE wj) ")"))
    
22.           nz (length z)
    
23.           y  (read (strcat "(" (READ-LINE wj) ")"))
    
24.           ny (length y)
    
25.           px (nth 0 p)
    
26.           py (nth 1 p)
    
27.           p  (list px (+ py 4))
    
28.     )
    
29.     (mkla "中心线" 1)
    
30.     (command "line" (list px (+ py 1)) (list px (- py 1)) "") ;画中心线
    
31.     (setq zh1 (fix (/ zh 1000))
    
32.           zh  (- zh (* zh1 1000))
    
33.     )
    
34.     (cond
    
35.       ((> zh 99.9995) (setq zh2 (rtos zh 2 3)))
    
36.       ((< zh 9.9995) (setq zh2 (strcat "00" (rtos zh 2 3))))
    
37.       ((< zh 99.9995) (setq zh2 (strcat "0" (rtos zh 2 3))))
    
38.     )
    
39.     (setq zh (strcat "K" (rtos zh1 2 0) "+" zh2))
    
40.     (mkla "桩号" 3)
    
41.     (command "text"
    
42.              "j"
    
43.              "m"
    
44.              (list px (- py 1.6))
    
45.              (* SC 0.5)
    
46.              0
    
47.              zh
    
48.     )                                        ;标桩号
    
49.     (setq temp 1                        ;画地面线
    
50.           px1 px
    
51.           py1 py
    
52.     )
    
53.     (mkla "地面线" 4)
    
54.     (command "pline" (list px1 py1))
    
55.     (while (> ny 2)
    
56.       (setq px2        (+ px (nth temp y))
    
57.             py2        (+ py (nth (+ temp 1) y))
    
58.       )
    
59. 
    
60.       (command (list px2 py2))
    
61.       (setq ny         (- ny 2)
    
62.             temp (+ temp 2)
    
63.       )
    
64.     )
    
65.     (command "")
    
66. 
    
67.     (setq temp 1
    
68.           px1 px
    
69.           py1 py
    
70.     )
    
71.     (command "pline" (list px1 py1))
    
72.     (while (> nz 2)
    
73.       (setq px2        (- px (nth temp z))
    
74.             py2        (+ py (nth (+ temp 1) z))
    
75.       )
    
76.       (command (list px2 py2))
    
77.       (setq nz         (- nz 2)
    
78.             temp (+ temp 2)
    
79.       )
    
80.     )
    
81.     (command "")
    
82.   )
    
83.   (close wj)
    
84.   (CMDLA1)
    
85. )[/FONT]

[FONT=courier new](load "xyp_lib")<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：<br /> 1.在acad.lsp中增加(load"xyp_lib")<br /> 2.在每个程序内增加(load"xyp_lib")<br /> 3.在command下，输入(load"xyp_lib")<br /> 4.在菜单.mnl中增加(load"xyp_lib")<br /> 5.将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR][url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]|;<br /> <br /> (DEFUN C:test (/ wj zh zh1 zh2 z y nz ny p px py px1 py1 px2 py2 temp)<br />   (CMDLA0)<br />   (jzhz)<br />   (SETQ        wj (OPEN (getfiled "坐标数据文件(txt)" "" "txt" 2) "r")<br />         p  (getpoint "选择绘图基点")<br />   )<br />   (while (setq ptt (READ-LINE wj))<br />     (SETQ zh (atof ptt)<br />           z  (read (strcat "(" (READ-LINE wj) ")"))<br />           nz (length z)<br />           y  (read (strcat "(" (READ-LINE wj) ")"))<br />           ny (length y)<br />           px (nth 0 p)<br />           py (nth 1 p)<br />           p  (list px (+ py 4))<br />     )<br />     (mkla "中心线" 1)<br />     (command "line" (list px (+ py 1)) (list px (- py 1)) "") ;画中心线<br />     (setq zh1 (fix (/ zh 1000))<br />           zh  (- zh (* zh1 1000))<br />     )<br />     (cond<br />       ((> zh 99.9995) (setq zh2 (rtos zh 2 3)))<br />       ((< zh 9.9995) (setq zh2 (strcat "00" (rtos zh 2 3))))<br />       ((< zh 99.9995) (setq zh2 (strcat "0" (rtos zh 2 3))))<br />     )<br />     (setq zh (strcat "K" (rtos zh1 2 0) "+" zh2))<br />     (mkla "桩号" 3)<br />     (command "text"<br />              "j"<br />              "m"<br />              (list px (- py 1.6))<br />              (* SC 0.5)<br />              0<br />              zh<br />     )                                        ;标桩号<br />     (setq temp 1                        ;画地面线<br />           px1 px<br />           py1 py<br />     )<br />     (mkla "地面线" 4)<br />     (command "pline" (list px1 py1))<br />     (while (> ny 2)<br />       (setq px2        (+ px (nth temp y))<br />             py2        (+ py (nth (+ temp 1) y))<br />       )<br /> <br />       (command (list px2 py2))<br />       (setq ny         (- ny 2)<br />             temp (+ temp 2)<br />       )<br />     )<br />     (command "")<br /> <br />     (setq temp 1<br />           px1 px<br />           py1 py<br />     )<br />     (command "pline" (list px1 py1))<br />     (while (> nz 2)<br />       (setq px2        (- px (nth temp z))<br />             py2        (+ py (nth (+ temp 1) z))<br />       )<br />       (command (list px2 py2))<br />       (setq nz         (- nz 2)<br />             temp (+ temp 2)<br />       )<br />     )<br />     (command "")<br />   )<br />   (close wj)<br />   (CMDLA1)<br /> )[/FONT]

yjrun

首先，图层的设置是有用的，这样对于后面的调整有帮助。
画pline，建议使用active方法。如果使用循环，
eg： （command "pline")
  （repeat n
          (command p1）
  )

falconry

感谢回复,PLINE问题解决,斑竹的xyp_lib文件感觉很牛,不知有没有说明

MUYIY

感谢