纬地数据转换为飞时达数据

wangyonggao8

(princ "\n程序--------纬地数据转换为飞时达数据")
(princ "\n------------------------------------")
(princ "\n-----------命令:zh   ---------------")
(defun c:zh ()
  (setq        os (getvar "osmode")
        om (getvar "cmdecho")
  )
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (if (not file-path)
    (setq file-path "d:\\mtools")
  )
  (setq        filename1
         (getfiled
           "请选择纬地地面线数据文件:"
           (strcat file-path "\\")
           "dmx"
           8
         )
  )
  (setq file-path (vl-filename-directory filename1))
  (setq        filename2
         (getfiled
           "请选择纬地横断面数据文件:"
           (strcat file-path "\\")
           "hdm"
           8
         )
  )
  (setq
    filename3 (strcat file-path
                      "\\"
                      (vl-filename-base filename1)
                      ".zdx"
              )
  )
  (setq
    filename4 (strcat file-path
                      "\\"
                      (vl-filename-base filename2)
                      ".hdx"
              )
  )
  (setq        file1 (open filename1 "r")
        file2 (open filename2 "r")
        file3 (open filename3 "w")
        file4 (open filename4 "w")
  )
  (setq        i 0
        j 0
        dmx-list '()
        hdm-list '()
  )
  (read-line file1)
  (while (setq readline1 (read-line file1))
    (progn
      (setq ele1 (read (strcat "(" readline1 ")")))
      (setq dmx-list (cons ele1 dmx-list))
    )
  )
  (setq dmx-list (reverse dmx-list))
  (setq ttt t)
  (while ttt
    (progn
      (setq hdm-list1 '())
      (if (read-line file2)
        (setq ttt t)
        (setq ttt nil)
      )
      (repeat 3
        (progn
          (setq readline2 (read-line file2))
          (if readline2
            (progn
              (setq ttt t)
              (setq ele2 (read (strcat "(" readline2 ")")))
              (setq hdm-list1 (cons ele2 hdm-list1))
            )
            (setq ttt nil)
          )
        )
      )
      (setq hdm-list1 (reverse hdm-list1))
      (if (not (eq hdm-list1 '()))
        (setq hdm-list (cons hdm-list1 hdm-list))
      )
    )
  )
  (setq hdm-list (reverse hdm-list))

;;;生成飞时达纵断文件
  (setq        num_dmx        (length dmx-list)
        i        0
        j        0
        k        0
  )
  (princ num_dmx file3)
  (princ "\n" file3)
  (repeat num_dmx
    (setq dmx_no_i (nth i dmx-list))
    (princ (car dmx_no_i) file3)
    (princ "\t" file3)
    (princ (cadr dmx_no_i) file3)
    (princ "\n" file3)
    (setq i (+ i 1))
  )
;;;生成飞时达横断面地面线数据
  (setq        num_hdm        (length hdm-list)
        i        0
  )
  (princ num_hdm file4)
  (princ "\n" file4)
  (repeat num_hdm
    (setq hdm_i (nth i hdm-list))
    (setq hdm_zh (car (car hdm_i)))
    (princ hdm_zh file4)
    (princ "\n" file4)
    (setq left_hdm (cadr hdm_i)
          rigth_hdm (caddr hdm_i))

    (setq left_num(/ (- (length left_hdm) 1) 2)
          rigth_num(/ (- (length rigth_hdm) 1) 2))
    (princ (+ left_num 1) file4)
    (princ "\t" file4)
    (princ (+ rigth_num 1) file4)
    (princ "\n" file4)
    (setq zggc_zh(cadr (assoc hdm_zh dmx-list)))
;;;    (setq zggc_zh 0)
    (princ "0" file4)
    (princ "\t" file4)
    (princ zggc_zh file4)
    (princ "\n" file4)
    (setq j 0)   
    (repeat left_num
      (setq juli1(nth (+ (* 2 j) 1) left_hdm)
            gc1(+ (nth (+ (* 2 j) 2) left_hdm) zggc_zh))
      (princ juli1 file4)
      (princ "\t" file4)
      (princ gc1 file4)
      (princ "\n" file4)
      (setq j (+ j 1))
      )
    (princ "0" file4)
    (princ "\t" file4)
    (princ zggc_zh file4)
    (princ "\n" file4)
    (setq k 0)   
    (repeat rigth_num
      (setq juli2(nth (+ (* 2 k) 1) rigth_hdm)
            gc2(+ (nth (+ (* 2 k) 2) rigth_hdm) zggc_zh))
      (princ juli2 file4)
      (princ "\t" file4)
      (princ gc2 file4)
      (princ "\n" file4)
      (setq k (+ k 1))
      )   
    (setq i (+ i 1))
  )
  (close file1)
  (close file2)
  (close file3)
  (close file4)
  (setvar "osmode" os)
  (setvar "cmdecho" om)
  (print "OK!")
  (princ)
)

叮咚

f4800

纬地数据转换为飞时达数据   不错的程序  留名  记号

f4800

纬地数据转换为飞时达数据
多谢楼主分享的源代码