求大侠帮我完善这个程序！

遢绅~^士 · 发表于 2012-6-12 12:47

(defun C:hdmsj()
(setvar "cmdecho" 0)
(setq ff (open (getfiled "文件保存为" "c:/" "hdm" 1) "a"))
(or zx
(setq zx 0)
)
(princ "\n 是否添加中线参数：<0>添加;<1>不添加:<")
(princ zx)
(if (setq tmp (getreal ">: "))
(setq zx tmp)
)
(ang)
)
(defun zxcs()
(setq zzh (getreal"\n请输入中桩高程："))
(setq zxh (strcat "next"))
(write-line zxh ff)
(setq zzh0 (rtos zzh 2 3))
(setq zzh1 (strcat "0,"zzh0))
(write-line zzh1 ff)
(setq zzh00 (rtos (- zzh 3) 2 3))
(setq zzh2 (strcat "0," zzh00))
(write-line zzh2 ff)
)
(defun ang()
(setq pt1 (getpoint "\n拾取纵断面上的一点："))
(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq pt2 (getpoint "\n拾取纵断面上的第二点（道路前进方向）："))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq pt11 (list y1 x1))
(setq pt12 (list y2 x2))
(setq ang (angle pt11 pt12))
(hdm)
)
;拾取高程点进行平距计算
(defun hdm()
(setvar "cmdecho" 0) ;指令执行过程不响应
(setq zh (getreal"\n请输入桩号："))
(setq zh1 (rtos zh 2 3))
(setq zh2 (strcat "BEGIN," zh1))
(write-line zh2 ff)
(while (setq en (entsel "\n选择高程点:"))
(setvar "cmdecho" 0)
(redraw (car en) 3)
(setq en_data (entget (car en))) ;取得元体资料列表
(setq pt (cdr (assoc 10 en_data))) ;求得高程点坐标pt
(setq py (nth 0 pt));提取测量坐标系Y值
(setq px (nth 1 pt));提取测量坐标洗X值
(setq cj (-(* (- py x1) (cos ang)) (* (- px y1) (sin ang))));该行要注意数学坐标与测量坐标的互换计算垂直距离（cj）
(setq dist (rtos cj 2 3))
(setq pz(rtos (nth 2 pt)2 3));提取测量坐标系Z值
(setq pdz (strcat dist","pz));输出为CASS数据格式（平距,高程）
(write-line pdz ff);将数据写入文本
(princ pdz)
)
(while (/= 52 (getvar "cmdactive");
(if (= zx 0)(zxcs));判断是否写入中线参数
(setq xuanze (getreal"\n 1.选取下一个横断面高程点；2.选择新的切线；3.退出<1>："))
(if (= xuanze nil)(hdm))
(if (= xuanze 1 )(hdm))
(if (= xuanze 2 ) (ang))
(if (= xuanze 3 )(close ff)
(princ"已经退出！"))
)
)
(prin1)
)
(prompt "**从CAD中提取高程点或（point）点坐标，* << C:hdmsj >> *输出CASS横断面（平距,高程）数据* By 罗泽钢*葛洲坝基础公司*")
(prin1)