CASS横断面数据转纬地横断面数据

wyl120125 · 发表于 2021-5-21 13:03

学习学习

明镜亦非台 · 发表于 2021-5-22 13:15

我发个写的

;2021年4月24日 03:26:56  于新疆石河子
;将提取的南方cass横断面数据转为纬地格式，文件最后一行属于一个字母“B”，否则最后一条不能转出
(defun c:ww( /  file file0 file2 hang-num i ii l+h left_lst licheng lst  n  right_lst  y_num z_num zz)
  (setq file0(getfiled "选择CASS横断面文件<.dat>" "c:/" "hdm;dat;txt;*" 8))
  (setq file (open file0 "r"))
  (setq hang-num 0)
  (while (read-line file)(setq hang-num (1+ hang-num)));首先取得行数，末尾的空行应手动消除
  (close file)
  (setq file2 (open "c:/转纬地.txt" "w"))
  (setq lst'())
  (Setq file(open file0 "r"))
  (setq n(read-line file))
  (setq licheng(car(Fsxm-Split(cadr(Fsxm-Split n ",")) ":")));取得第一行的里程

  (repeat (- hang-num 1);循环第二行开始读取
(setq n(read-line file))
(if(null(wcmatch n "B*"))
   (progn
(Setq L+H(mapcar 'read (Fsxm-Split n ",")))
(Setq lst(cons L+H lst))
   );progn

   ;如果再读到Begin，就写数据
   (progn
   (setq i -1)(setq left_lst '())(setq right_lst '())
(repeat(length lst)
   (setq x(nth(setq i(1+ i))lst))
   (cond
      ((>(car x)0)(setq right_lst(cons x right_lst)))
      ((<(car x)0)(setq left_lst(cons (mapcar 'abs x) left_lst)))
      ((=(car x)0)(setq zz x))
      );cond
);repeat
  (setq right_lst(vl-sort (cons zz right_lst) '(lambda (a b) (<(car a)(car b)))))
  (setq z_num(itoa(-(length right_lst)1)))
  (setq ii 0)
  (repeat(-(length right_lst)1)
(setq z_num(strcat z_num " "(rtos(-(car(nth(1+ ii)right_lst))(car(nth ii right_lst)))2 3)))
(setq z_num(strcat z_num " "(rtos(-(cadr(nth(1+ ii)right_lst))(cadr(nth ii right_lst)))2 3)))
(setq ii(1+ ii))
)
  (setq left_lst(vl-sort (cons zz left_lst) '(lambda (a b) (<(car a) (car b)))))
  (setq y_num(itoa(-(length left_lst)1)))
  (setq ii 0)
  (repeat(-(length left_lst)1)
(setq y_num(strcat y_num " "(rtos(-(car(nth(1+ ii)left_lst))(car(nth ii left_lst)))2 3)))
(setq y_num(strcat y_num " "(rtos(-(cadr(nth(1+ ii)left_lst))(cadr(nth ii left_lst)))2 3)))
(setq ii(1+ ii))
)
   (write-line (strcat " " licheng) file2)
   (write-line (strcat " "y_num) file2)
   (write-line (strcat " "z_num) file2)
   (setq licheng(car(Fsxm-Split(cadr(Fsxm-Split n ",")) ":")))
   (setq left_lst nil)
   (setq right_lst nil)
   (setq lst nil)
   )
   )
   );repeat

  (close file)
  (close file2)
  );defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;飞诗字符串分割
(defun Fsxm-Split (string strkey / po strlst xlen)
  (setq xlen (1+ (strlen strkey)))
  (while (setq po (vl-string-search strkey string))
(setq strlst (cons (substr string 1 po) strlst))
(setq string (substr string (+ po xlen)))
) ;_ 结束while
  (reverse (cons string strlst))
  );_ 结束defun