求高手帮我修改下这个计算坡度的程序！
(defun c:podu( / a a1 d dx dy i os p1 p2 pt0 str stri)(princ "\n欢迎使用坡度标注程序！ 命令podu")
(princ "\n分别选择需要计算的两个高程数据:")
(princ "\n别多选，选多了计算一定会出错!")
(setq s (ssget))
(setq n (sslength s))
(setq k 0 )(setq hh 0.0)
(while (< k n)
(setq name (ssname s k))
(setq a (entget name))
(setq t1 (assoc '0 a))
(setq t1 (cdr t1))
(if (= t1 "TEXT") (PROGN
(setq tx (assoc '1 a))
(setq tx (cdr tx))
(setq tx (atof tx))
(if (= k 0) (setq hh TX))
(if (/= k 0) (setq hh (- hh tx)))
))
(setq k (+ k 1))
)
; (setq hh (rtos hh 2 2));计算出高差
; (princ "\n高程差为:" hh)
;------------------------------------------------
(setq olay (getvar "clayer"))
(setvar "cmdecho" 0)
;==================================================
(princ "\n选择坡度线（可以是PL或L，支持多选）:")
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 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 2);坡坡度取1位小数
SUMLEN1 (rtos SUMLEN 2 2);坡长取2位小数
text (if (= dx 0) "垂直" (strcat "i=" stri "%" "L=" SUMLEN1 "m"))
)
;===================开始输出结果==========================
(command "undo" "g")
(setq os (getvar "osmode"))
(setvar "osmode" 1)
(setq p1 (getpoint "\标注箭头的位置：")
p2 (getpoint "\n标注箭尾的方向：" p1)
ang (angle p1 p2)
ang2 (* ang 57.3)
ang5 (+ 70 ang)
pt0 (polar p1 ang5 1.5) ; 确定文字距离箭头的偏移位置
)
(setvar "osmode" os)
(grdraw p1 p2 2)
(setq olay (getvar "clayer"))
(command "_layer" "m" "DM-坡度标注" "c" "3" "" "")
(command "pline" p1 "w" "0" "1.3" (polar p1 ang 5) "w" "0" "0" (polar p1 ang 43) "")
(command "text" "j" "bl" pt0 "3.0" ang2 text) ;pt0=文字位置，ang2=文字的角度，text=文本数据 ,bl表示文字对齐点为左下
(command "undo" "e")
(command "layer" "s" olay "")
(princ)
)
这个程序上半部分是从别人那里找来拼凑起来的，下半部分是我自己写的，请高手帮我修改下
1.按顺序选择第一个高程，第二个高程
2.判断两个数的大小并计算差值，这个程序目前会计算出负值来。。。。。
3.还有其他可以修改的更完善的，请高手修改下，谢谢！
本帖最后由 hb198075 于 2012-3-31 11:24 编辑
你这个不太好改，发个我的给你用用。
不知道为什么我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") 收到，谢谢楼上！ hb198075，还是以毫米为单位的推算，牛x hb198075 发表于 2012-3-21 16:24
你这个不太好改，发个我的给你用用。
不知道为什么我30K的文件也说太大了不让传。
发的链接，我也不知道 ...
这个程序真牛x
页:
[1]