[编程申请]：我要展点程序

LYT1994

我要展点程序，要VB的原代码

起子

有用ＬＩＳＰ编好的，不过是我们单位上别人编的
我自己也在写一个展点程序，好了就放上来。

rzdzt

写好了能发给我一个吗?不好意思, RZdzt@163.com.多谢了

LYT1994

我的邮箱为：lyt1994@sina.com

fjalnj

小牛测绘上有，但VB原码得找作者联系

起子

(defun c:zd()
  (setvar "cmdecho" 0)
  (command "layer" "n" "dh" "c" "1" "dh" "")
  (command "layer" "n" "gc" "c" "2" "gc" "")
  (command "layer" "n" "sd" "c" "3" "sd" "")
  (setq bl (getREAL "请输入比例尺(500):"))
  (if (= bl nil) (setq bl 500))
  (setq n (/ bl 500))
  (setq zg (* 1.2 n))
  (setq ffn (getfiled "请输入成图文件:" "" "*" 2))
  (setq ff (open ffn "r"))
  (setq data (read-line ff))
  (while data
        (sd)
        (command "clayer" "sd")
        (command "point" xy)
        (command "clayer" "dh")
        (command "text" xy1 zg 0 dh)
        (command "clayer" "gc")
        (command "text" xy2 zg 0 h)
        (setq data (read-line ff))
  )
  (close ff)
  (command "zoom" "e")
  (prin1)
  )

(defun sd()
  (setq i 1)
  (setq p (substr data i 1))
  (while (/= p ",")
    (setq i (+ i 1))
    (setq p (substr data i 1))
    )
  (setq dh (substr data 1 (- i 1)))
  (setq data1 (substr data (+ i 1)))
  (setq k 1)
  (setq pp (substr data1 k 1))
  (while (/= pp ",")
    (setq k (+ k 1))
    (setq pp (substr data1 k 1))
    )
  (setq x (atof (substr data1 1 (- k 1))))
  (setq data2 (substr data1 (+ k 1)))
  (setq j 1)
  (setq ppp (substr data2 j 1))
  (while (/= ppp ",")
     (setq j (+ j 1))
     (setq ppp (substr data2 j 1))
     )
  (setq y (atof (substr data2 1 (- j 1))))
  (setq h (substr data2 (+ j 1)))
  (setq xy (list y x))
  (setq x1 (+ x 1))
  (setq y1 (+ y 1))
  (setq xy1 (list y1 x1))
  (setq xy2 (list y1 x))
  )



这个程序展点的数据文件的格式为
点号，X坐标，Y坐标，高程
注意：中间的逗号必须要，不然要出错
如：
带高程：
12,12534,125.22,520.00

不带高程：
12，5555.00，1221，

这个程序是另一个人（XX）写的，不是我写的
我在写另外一个，最好是能判断带不带逗号。

njyulei

把坐标文件编写成以下格式
1,x,y,h
的文本文件(*.dat  文件名)就可以在南方cass5.1中展点了不需要别的什么程序。

hisum

有时间自己就可以编一个，这是最容易的程序，不要老想拿别人的，对自己的提高可没好处

dna111

去哪下载CASS啊

xiao_longxin

最初由 hisum 发布
[B]有时间自己就可以编一个，这是最容易的程序，不要老想拿别人的，对自己的提高可没好处 [/B]

强烈同意你的意见，因为每个人都有自己的数据格式，最好能自己动手。