lisp合并

jactry

(defun c:hdm1()
(setq lay_name2 (getstring "\n  请输点号所在图层<GCD>:"))
(if (= lay_name2 "") (setq lay_name2 "GCD"))
(setq fname0 (getfiled "请输数据存盘文件名" "e:/" "hdm" 1))
(setq data (rtos (getvar "cdate") 2 0))
  (setq fcg2 (open fname0 "w"))
  (close fcg2)
    (setvar "osmode" 8)
    (setvar "osmode" 4)
(while
(setq fcg (open fname0 "a"))
(write-line  "BEGIN" fcg)
(close fcg)
  (setq pt0 (getpoint "\n 请选中桩点"))
(setq x0 (nth 0 pt0) y0 (nth 1 pt0) h0 (nth 2 pt0))
(setq xa x0)
(setq ya y0)
  (setq pt pt0)
(SETQ X (NTH 0 pt))
(SETQ y (NTH 1 pt))
(setq h (nth 2 pt))
(setq y0 (- y (* (/ (getvar "userr1") 1000.0) 2)))
(setq y1 (+ y (* (/ (getvar "userr1") 1000.0) 2)))
(setq x1 (+ x (* (/ (getvar "userr1") 1000.0) 4)))
(setq p0 (list x y0) p1 (list x1 y1))
(setvar "osmode" 0)
  (command "_rectang" p0 p1)
  (setvar "osmode" 8)
  (setvar "osmode" 4)
(while
  (setq pt1 (getpoint "\n 请先选左边点"))
(command "circle" pt1 "0.5")
  (setq x1 (nth 0 pt1) y1 (nth 1 pt1) h1 (nth 2 pt1))
  (if (= 0 h1)
    (setq h2 (getstring "\n 请输入高程:")))
    (setq dx (- xa x1) dy (- ya y1))
(setq lj (sqrt (+ (* dx dx) (* dy dy))))
(setq lj (rtos lj 2 2))
      (setq x x1 y y1 h h1)
(setq hh (rtos h1 2 2))
  (if (= x1 xa)
    (progn
    (if (= 0 h1) (setq f (strcat lj "," h2))
    (setq f (strcat lj "," hh)))
    (setq fcg2 (open fname0 "a"))
  (write-line f fcg2)
(close fcg2)
)
    (progn
    (if (= 0 h1) (setq f (strcat "-" lj "," h2))
    (setq f (strcat "-" lj "," hh)))
  (setq fcg2 (open fname0 "a"))
  (write-line f fcg2)
(close fcg2)
  )
    )
  (if (= x1 xa)
      (while
    (setq pt1 (getpoint "\n 请选右边点"))
(command "circle" pt1 "0.5")
  (setq x1 (nth 0 pt1) y1 (nth 1 pt1) h1 (nth 2 pt1))
    (if (= 0 h1)
    (setq h2 (getstring "\n 请输入高程:")))
    (setq dx (- xa x1) dy (- ya y1))
(setq lj (sqrt (+ (* dx dx) (* dy dy))))
(setq lj (rtos lj 2 2))
  (setq x x1 y y1 h h1)
(setq hh (rtos h1 2 2))
    (if (= 0 h1) (setq f (strcat lj "," h2))
    (setq f (strcat lj "," hh)))
  (setq fcg2 (open fname0 "a"))
     (write-line f fcg2)
(close fcg2)
)
      )
    )
    (setq fcg (open fname0 "a"))
  (write-line  "end" fcg)
(close fcg)
  )
  (princ)
      )
(while (/= 52 (getvar "cmdactive");
(setq xuanze (getreal"\n 1.选取下一个横断面高程点；2.退出<1>："))
(if (= xuanze nil)(hdm))
(if (= xuanze 1 )(hdm))
(if (= xuanze 2 )(princ"已经退出！"))
)
)
(prin1)
)
(prompt "**从CASS中提取高程点或（point）点坐标，* << C:open_ff >> *输出横断面（平距,高程）数据**")
(prin1)


这段代码如何加入
;拾取高程点进行平距计算
(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 (/= 52 (getvar "cmdactive");
(setq xuanze (getreal"\n 1.选取下一个横断面高程点；2.选择新的切线；3.退出<1>："))
(if (= xuanze nil)(hdm))
(if (= xuanze 1 )(hdm))
(if (= xuanze 2 ) (fwjjs))
(if (= xuanze 3 )(princ"已经退出！"))
)
)
(prin1)
)
进行循环

jactry

求助LISP高手相助，急用

ysq101

没说清楚你要做什么啊？

zxq0220

不知道程序是干什么的？写的乱且有一段在主程序之外。