求高手帮我修改下这个计算坡度的程序！

77077

1. (defun c:podu( / a a1 d dx dy i os p1 p2 pt0 str stri)
   
2.   (princ "\n欢迎使用坡度标注程序！ 命令podu")
   
3.   (princ "\n分别选择需要计算的两个高程数据:")
   
4.   (princ "\n别多选，选多了计算一定会出错!")
   
5. (setq s (ssget))
   
6. (setq n (sslength s))
   
7. (setq k 0 )(setq hh 0.0)
   
8. (while (< k n)
   
9.       (setq name (ssname s k))
   
10.       (setq a (entget name))
    
11.       (setq t1 (assoc '0 a))
    
12.       (setq t1 (cdr t1))
    
13.       (if (= t1 "TEXT") (PROGN
    
14.           (setq tx (assoc '1 a))
    
15.           (setq tx (cdr tx))
    
16.           (setq tx (atof tx))
    
17.           (if (= k 0) (setq hh TX))
    
18.           (if (/= k 0) (setq hh (- hh tx)))
    
19.          ))
    
20.       (setq k (+ k 1))
    
21. )
    
22. ; (setq hh (rtos hh 2 2));计算出高差
    
23. ; (princ "\n高程差为:" hh)
    
24. ;------------------------------------------------
    
25.   (setq olay (getvar "clayer"))
    
26.   (setvar "cmdecho" 0)
    
27. ;==================================================
    
28.   (princ "\n选择坡度线（可以是PL或L，支持多选）:")
    
29.   (vl-load-com)
    
30.   (setq SUMLEN 0)
    
31.   (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
    
32.   (setq N 0)
    
33.   (repeat (sslength SS)
    
34.     (setq CURVE (vlax-ename->vla-object (ssname SS N)))
    
35.     (setq TLEN (vlax-curve-getdistatparam
    
36. CURVE
    
37. (vlax-curve-getendparam CURVE)
    
38.        )
    
39.     )
    
40.     (setq SUMLEN (+ SUMLEN TLEN))
    
41.     (setq N (1+ N))
    
42.   )
    
43. ;(setq SUMLEN1 (rtos SUMLEN 2 3));计算出坡长为SUMLEN1
    
44. ;=======================开始计算坡度========================
    
45.   (setq i (* (/ hh SUMLEN) 100);计算出坡度
    
46.         stri (rtos i 2 2);坡坡度取1位小数
    
47.         SUMLEN1 (rtos SUMLEN 2 2);坡长取2位小数
    
48.         text (if (= dx 0) "垂直" (strcat "i=" stri "%" "  L=" SUMLEN1 "m"))
    
49.   )
    
50. ;===================开始输出结果==========================
    
51.   (command "undo" "g")
    
52.   (setq os (getvar "osmode"))
    
53.   (setvar "osmode" 1)
    
54.   (setq p1 (getpoint "\标注箭头的位置：")
    
55.         p2 (getpoint "\n标注箭尾的方向：" p1)
    
56.        ang (angle p1 p2)
    
57.         ang2 (* ang 57.3)
    
58.        ang5 (+ 70 ang)
    
59.        pt0 (polar p1 ang5 1.5) ; 确定文字距离箭头的偏移位置
    
60.   )
    
61.   (setvar "osmode" os)
    
62.   (grdraw p1 p2 2)
    
63.         (setq olay (getvar "clayer"))
    
64.         (command "_layer" "m" "DM-坡度标注" "c" "3" "" "")
    
65.         (command "pline" p1 "w" "0" "1.3" (polar p1 ang 5) "w" "0" "0" (polar p1 ang 43) "")
    
66.         (command "text" "j" "bl" pt0 "3.0" ang2 text) ;pt0=文字位置，ang2=文字的角度，text=文本数据 ,bl表示文字对齐点为左下
    
67.     (command "undo" "e")
    
68.        (command "layer" "s" olay "")
    
69.   (princ)
    
70. )

(defun c:podu( / a a1 d dx dy i os p1 p2 pt0 str stri) <br />   (princ "\n欢迎使用坡度标注程序！ 命令podu") <br />   (princ "\n分别选择需要计算的两个高程数据:")<br />   (princ "\n别多选，选多了计算一定会出错!") <br /> (setq s (ssget))<br /> (setq n (sslength s))<br /> (setq k 0 )(setq hh 0.0)<br /> (while (< k n) <br />       (setq name (ssname s k))<br />       (setq a (entget name))<br />       (setq t1 (assoc '0 a))<br />       (setq t1 (cdr t1))<br />       (if (= t1 "TEXT") (PROGN<br />           (setq tx (assoc '1 a))<br />           (setq tx (cdr tx))<br />           (setq tx (atof tx))<br />           (if (= k 0) (setq hh TX))<br />           (if (/= k 0) (setq hh (- hh tx)))<br />          ))<br />       (setq k (+ k 1))<br /> )<br /> ; (setq hh (rtos hh 2 2));计算出高差<br /> ; (princ "\n高程差为:" hh)<br /> ;------------------------------------------------<br />   (setq olay (getvar "clayer"))<br />   (setvar "cmdecho" 0)<br /> ;==================================================<br />   (princ "\n选择坡度线（可以是PL或L，支持多选）:")<br />   (vl-load-com) <br />   (setq SUMLEN 0) <br />   (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC")))) <br />   (setq N 0) <br />   (repeat (sslength SS) <br />     (setq CURVE (vlax-ename->vla-object (ssname SS N))) <br />     (setq TLEN (vlax-curve-getdistatparam <br /> CURVE <br /> (vlax-curve-getendparam CURVE) <br />        ) <br />     ) <br />     (setq SUMLEN (+ SUMLEN TLEN)) <br />     (setq N (1+ N)) <br />   ) <br /> ;(setq SUMLEN1 (rtos SUMLEN 2 3));计算出坡长为SUMLEN1<br /> ;=======================开始计算坡度========================<br />   (setq i (* (/ hh SUMLEN) 100);计算出坡度<br />         stri (rtos i 2 2);坡坡度取1位小数<br />         SUMLEN1 (rtos SUMLEN 2 2);坡长取2位小数<br />         text (if (= dx 0) "垂直" (strcat "i=" stri "%" "  L=" SUMLEN1 "m")) <br />   ) <br /> ;===================开始输出结果==========================<br />   (command "undo" "g") <br />   (setq os (getvar "osmode")) <br />   (setvar "osmode" 1) <br />   (setq p1 (getpoint "\标注箭头的位置：") <br />         p2 (getpoint "\n标注箭尾的方向：" p1) <br />        ang (angle p1 p2) <br />         ang2 (* ang 57.3)<br />        ang5 (+ 70 ang) <br />        pt0 (polar p1 ang5 1.5) ; 确定文字距离箭头的偏移位置<br />   )<br />   (setvar "osmode" os) <br />   (grdraw p1 p2 2)<br />         (setq olay (getvar "clayer"))<br />         (command "_layer" "m" "DM-坡度标注" "c" "3" "" "")<br />         (command "pline" p1 "w" "0" "1.3" (polar p1 ang 5) "w" "0" "0" (polar p1 ang 43) "")<br />         (command "text" "j" "bl" pt0 "3.0" ang2 text) ;pt0=文字位置，ang2=文字的角度，text=文本数据 ,bl表示文字对齐点为左下<br />     (command "undo" "e") <br />        (command "layer" "s" olay "")<br />   (princ) <br /> )

这个程序上半部分是从别人那里找来拼凑起来的，下半部分是我自己写的，请高手帮我修改下
1.按顺序选择第一个高程，第二个高程
2.判断两个数的大小并计算差值，这个程序目前会计算出负值来。。。。。
3.还有其他可以修改的更完善的，请高手修改下，谢谢！

hb198075

你这个不太好改，发个我的给你用用。
不知道为什么我30K的文件也说太大了不让传。
发的链接，我也不知道能不能用啊。

叮咚

(defun c:podu ()
  (vl-load-com)
  (setq os (getvar "osmode"))
  (princ "\n分别选择需要计算的两个高程数据:")
  (setq en1 (car (entsel "\n选择第一个数:")))
  (setq x1 (vlax-ename->vla-object en1))
  (setq h1 (atof (vla-get-textstring x1)))
  (while (null h1)
    (alert "\n选择一个数字!")
    (setq en1 (car (entsel "\n选择第一个数:")))
    (setq x1 (vlax-ename->vla-object en1))
    (setq h1 (atof (vla-get-textstring x1)))
  )
  (setq en2 (car (entsel "\n选择第二个数:")))
  (setq x2 (vlax-ename->vla-object en2))
  (setq h2 (atof (vla-get-textstring x2)))
  (while (null h2)
    (alert "\n选择一个数字!")
    (setq en2 (car (entsel "\n选择第一个数:")))
    (setq x2 (vlax-ename->vla-object en2))
    (setq h2 (atof (vla-get-textstring x2)))
  )
  (setq hh (abs (- h1 h2)))
  (setq olay (getvar "clayer"))
                                        ;==================================================
  (princ "\n选择坡度线（可以是PL或L，支持多选）:")
  (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
  (setq        N 0
        SUMLEN 0
  )
  (repeat (sslength SS)
    (setq CURVE (vlax-ename->vla-object (ssname SS N)))
    (setq TLEN (vlax-curve-getdistatparam
                 CURVE
                 (vlax-curve-getendparam CURVE)
               )
    )
    (setq SUMLEN (+ SUMLEN TLEN))
    (setq N (1+ N))
  )
                                        ;(setq SUMLEN1 (rtos SUMLEN 2 3));计算出坡长为SUMLEN1
                                        ;=======================开始计算坡度========================
  (setq        i      (* (/ hh SUMLEN) 100)        ;计算出坡度
        stri   (rtos i 2 1)                ;坡坡度取1位小数
        SUMLEN (rtos SUMLEN 2 2)        ;坡长取2位小数
        text   (if (= i 0)
                 "垂直"
                 (strcat "i=" stri "%" "  L=" SUMLEN "m")
               )
  )
                                        ;===================开始输出结果==========================
  (command "undo" "be")
  (setq os (getvar "osmode"))
  (setq        p1  (getpoint "\标注箭头的位置：")
        p2  (getpoint "\n标注箭尾的方向：" p1)
        ang (angle p1 p2)
        pt0 (polar p1 ang 1.5)                ; 确定文字距离箭头的偏移位置
  )
  (grdraw p1 p2 2)
  (setq olay (getvar "clayer"))
  (if (null (tblsearch "layer" "DM-坡度标注"))
    (command "_layer" "m" "DM-坡度标注" "c" "3" "" "")
  )
  (setvar "clayer" "DM-坡度标注")
  (setvar "osmode" 0)
  (command "pline"
           p1
           "w"
           "0"
           "1.3"
           (polar p1 ang 5)
           "w"
           "0"
           "0"
           (polar p1 ang 43)
           ""
  )
  (command "text" "bl" pt0 "3.0" (/ (* ang 180) pi) text)
                                        ;pt0=文字位置，ang=文字的角度，text=文本数据 ,bl表示文字对齐点为左下
  (setvar "clayer" olay)
  (command "undo" "e")
  (princ)
)
(prompt "\n欢迎使用坡度标注程序！ 命令podu")

77077

收到，谢谢楼上！

夺天工

hb198075，还是以毫米为单位的推算，牛x

waly008

hb198075 发表于 2012-3-21 16:24
你这个不太好改，发个我的给你用用。
不知道为什么我30K的文件也说太大了不让传。
发的链接，我也不知道 ...

这个程序真牛x