[LISP程序]：能在平面图上切剖面的程序

furge

该程序可以在平面图上切剖面，自动生成平距及高程，并能保存下来。注意，地形线为多段线且已赋高程才能显示高程数值，否则高称将显示为0。

2. 
   
3. (defun c:qpm()
   
4.           (setq sblip (getvar "blipmode"))
   
5.         (setq scmde (getvar "cmdecho"))
   
6.         (setvar "blipmode" 0)
   
7.         (setvar "cmdecho" 0)
   
8.   (SETQ BLLI(GETREAL "\n 输入比例<1>:"))
   
9.   (IF (= BLLI NIL) (SETQ BLLI 1))
   
10. (command "style" "sst" "宋体" "1.0" "0.6" "0" "n" "n")
    
11. (SETQ BCC ())
    
12.   (SETQ QQD(GETREAL "\n 输入起始长度<m>:"))
    
13.   (IF (= QQD NIL) (SETQ QQD 0))
    
14.   (setq dd(getpoint "\n 输入起点："))
    
15.   (setq dd10(reverse dd))
    
16. (setq dd11(cdr dd10))
    
17.   
    
18.   (WHILE
    
19.   (setq dd1(getpoint dd "\n 下一点："))
    
20. (setq dd1-1(caddr dd1))
    
21. (setq dd21(reverse dd1))
    
22. (setq dd22(cdr dd21))
    
23.   (setq jll(distance dd11 dd22))
    
24.   (SETQ JLL1(+ (* JLL BLLI) qqd))
    
25.   (SETQ JLL-1(RTOS dd1-1 2 2))
    
26.   (SETQ JLL1-1(RTOS JLL1 2 2))
    
27.   (SETQ BCC(CONS JLL1-1 BCC))
    
28. (SETQ JLL_L(STRCAT JLL1-1 "(" JLL-1 ")"))
    
29.   (command "text" "j" "bc" dd1 "0" jll_l)
    
30.   )
    
31. 
    
32.   (setq yn(getstring "\n 数据要保存吗<Y>："))
    
33.   (IF (OR (= YN "Y") (= YN "y"))
    
34.      (PROGN
    
35.         (SETQ K 0)
    
36.        (SETQ FILED(GETSTRING "\n 输入文件名<TEM>:"))
    
37.        (IF (= FILED "") (SETQ FILED "TEM"))
    
38.        (SETQ FILED1 (STRCAT FILED ".DAT"))
    
39.        (SETQ F1(OPEN FILED1 "a"))
    
40.        (SETQ BCC1(reverse BCC))
    
41.        (SETQ BCCLEN(LENGTH BCC1))
    
42.        (WHILE (< K BCCLEN)
    
43.          (SETQ BCC2(NTH K BCC1))
    
44.          ;(PRINT BCC2)
    
45.          (WRITE-LINE BCC2 F1)
    
46.          (SETQ K(+ K 1))
    
47.         )
    
48.        (CLOSE F1)
    
49.     )
    
50.    )
    
51. (setvar "blipmode" SBLIP)
    
52. (setvar "cmdecho" SCMDE)
    
53.   )

<br /> (defun c:qpm()<br />           (setq sblip (getvar "blipmode"))<br />         (setq scmde (getvar "cmdecho"))<br />         (setvar "blipmode" 0)<br />         (setvar "cmdecho" 0)<br />   (SETQ BLLI(GETREAL "\n 输入比例<1>:"))<br />   (IF (= BLLI NIL) (SETQ BLLI 1))<br /> (command "style" "sst" "宋体" "1.0" "0.6" "0" "n" "n")<br /> (SETQ BCC ())<br />   (SETQ QQD(GETREAL "\n 输入起始长度<m>:"))<br />   (IF (= QQD NIL) (SETQ QQD 0)) <br />   (setq dd(getpoint "\n 输入起点："))<br />   (setq dd10(reverse dd))<br /> (setq dd11(cdr dd10))<br />   <br />   (WHILE <br />   (setq dd1(getpoint dd "\n 下一点："))<br /> (setq dd1-1(caddr dd1))<br /> (setq dd21(reverse dd1))<br /> (setq dd22(cdr dd21))<br />   (setq jll(distance dd11 dd22))<br />   (SETQ JLL1(+ (* JLL BLLI) qqd))<br />   (SETQ JLL-1(RTOS dd1-1 2 2))<br />   (SETQ JLL1-1(RTOS JLL1 2 2))<br />   (SETQ BCC(CONS JLL1-1 BCC))<br /> (SETQ JLL_L(STRCAT JLL1-1 "(" JLL-1 ")"))<br />   (command "text" "j" "bc" dd1 "0" jll_l)<br />   )<br /> <br />   (setq yn(getstring "\n 数据要保存吗<Y>："))<br />   (IF (OR (= YN "Y") (= YN "y"))<br />      (PROGN<br />         (SETQ K 0)<br />        (SETQ FILED(GETSTRING "\n 输入文件名<TEM>:"))<br />        (IF (= FILED "") (SETQ FILED "TEM"))<br />        (SETQ FILED1 (STRCAT FILED ".DAT"))<br />        (SETQ F1(OPEN FILED1 "a"))<br />        (SETQ BCC1(reverse BCC))<br />        (SETQ BCCLEN(LENGTH BCC1))<br />        (WHILE (< K BCCLEN)<br />          (SETQ BCC2(NTH K BCC1))<br />          ;(PRINT BCC2)<br />          (WRITE-LINE BCC2 F1)<br />          (SETQ K(+ K 1))<br />         )<br />        (CLOSE F1)<br />     )<br />    ) <br /> (setvar "blipmode" SBLIP)<br /> (setvar "cmdecho" SCMDE)<br />   )

cqg2004ch

不行！

jinsong-liao

地形线赋高程数值工作量非常大，如果有别的更有效的赋值方法，那土方计算就简单多了！