自己动手,改进CASS中欠缺的功能

xgr

回复 wei3250 的帖子

在生成等高线后可以用高程点过滤掉过密的高程点即可。不过最好是先保存所有的高程点数据文件。

another2121

njcknfy 楼主
   这个贴子，是我看过最好的。。。也是第一个从头看到尾的贴子。。。。。从中学到了很多有用的东西。。。再次感谢楼主。。。。

another2121

njcknfy 楼主
     可以编一个关于检查图中拓朴关系的程序么？

lixiyu

高手还蛮多了。。。。

gzbccy

skg123 发表于 2010-5-6 17:05
CASS横断面处理的时候，不能把将断面线保存数据（平距，高程），提取横断面线，不让不确定中点位置，这个在 ...

对啊，公路中很麻烦的，希望加强改进。或者确定起点位置也不错啊

CELIANGYUAN

望楼主帮忙看一下，加载后语法错误
(defun c:gcdjc()
(setvar"cmdecho" 0)
(write-line "欢迎使用高程点自动检查与修改程序!")
(setq ent (ssget "x" '((8 . "gcd")(0 . "TEXT"))))
(if ent (progn
(command"zoom" "e")
(command"layer" "m" "gcd" "")
(setq ent-length (sslength ent))
(setq ent-num ber 0)
(repeat ent-length
(setq ent-name (ssname ent ent-num ber))
(c lgcd); 调入高程点检查与修改子程序
(setq ent-num ber (1+ ent-num ber))
)
(command"layer" "m" "0" "")
(command"zoom" "e")
(write-line "高程点检查修改完毕! ")
)
)
)
(defun c lgcd () ; 高程点检查与修改子程序
(setq data (entget ent-name))
(SETQ TEX (CDR (ASSOC 1 DATA))); 取得高程注记文本值
(setq p (cdr (assoc 10 data))) ; 取得高程注记文本位置坐标
(setq pl (polar p (* 1.25 pi) 7.0); 设置搜索范围
pr (polar p (* 0.25 pi) 10.0)
)
(setq ent-p (ssget "w" pl pr '((0 . "POINT") (8 . "gcd"))))
(if ent-p (progn ;注记周围有高程点
(SETQ p-length (sslength ent-p))
(setq p-num ber 0)
(setq p-data (entget (ssname ent-p p-num ber))); 取得高程点的数据表
(setq gcdz (rtos (cadddr (assoc 10 p-data)) 2 2))
(setq w c (- (a to f gcdz) (atof tex)))
(while (and (> = (abs wc) 0.01) (< p-number (1-p-length))) ; 对周围搜索到的高程点进行差值比较
(setq p-num ber (1+ p-num ber))
(setq p-data (entget (ssname ent-p p-number)))
(setq gcdz (rtos (cadddr (assoc 10 p-data)) 2 2))
(setq w c (- (atof gcdz) (atof tex))))
(if (> = (abs w c) 0.01)
(progn (command"zoom"pl pr)
(write-line   "无匹配高程点, 请选择需要修改的高程点,不选择则自动加点. ")
(redraw ent-name 3) ;加亮显示待处理的高程注记
(setq p-se l (ssget)) ; 交互式获取需修改的高程点
(redraw ent-name 4) ; 取消加亮显示
      (if p-se l
      (progn
         (setq se l (entget (ssname p-se l 0)))
         (setq X (caddr (assoc 10 se l))
               Y (caddr (assoc 10 se l))
        )
         (setq zb-new (list 10 X Y (atof tex)))
         (setq se l (subst zb-new (assoc 10 se l) se l))
         (entmod se l)
     )
      (jiagcd)
  )
   (command"zoom" "e")
)
     )
  )
   (jiagcd) ;注记周围无高程点则自动加点
  )
)
(defun jiagcd () ; 加高程点子程序
(setq p-xy (polar (polar p (* 0.5 pi) 0.5) pi 0.8))
(command"point" p-xy)
(command"change" "l" "" "p" "e" (atof tex) " ")
)

CELIANGYUAN

还有一个判断等高线点线矛盾的，提示列表有缺陷，望斑竹加以指点，我对着不太懂，但又要用
(defun c:dgx-dxmd()
(command"layer" "on" "dgx" "thaw" "dgx" "")
(command"layer" "on" "gcd" "thaw" "gcd" "")

(prompt"选择需要检查等高线点线矛盾的范围线，若还没有范围线，要先绘出。\n")

(setq entdgx (ssget "cp" list-p '((0 . "*POLYLINE")(8 . "dgx"))))

输入其他检查参数
(setq dis-dgx (getreal"\n输入允许的两等高线间距<6.0>:"))
(setq dgj (getreal "\n输入等高距<0.5>:"))
其中输入允许的两等高线间距的目的是为了提高检查速度，针对每幅图的不一致解性，在程序中设定屏幕输入两条等高线的最大间距。

(write-line"\n正在检查范围线内的等高线是否有点线矛盾……")
(Setq ent-long (sslength ent))
(Setq ent-n 0 n-error 0)
(repeat ent-LONG)
(setq ty (ssname ent ent-n))
(c:getgc-minmax)

;获取高程点附近的理论上存在的两根等高线高程 gc-min , gc-max
(defun c:getgc-minmax()

)

;检查高程点的点线矛盾cha-dxmd
(defun c:cha-dxmd()

(if(NOT (and (OR (equal gc-dgx1 gc-min wc-dgx)
　　　　　　　　 (equal gc-dgx1 gc-max wc-dgx))
　 　　　　 (OR (equal gc-dgx2 gc-min wc-dgx)
　 　　　　 (equal gc-dgx2 gc-max wc-dgx))))(progn
　 　　　　 (command"circle" p-point 5)
　 　　　　 (setq n-error (1+ n-error))
))

461045462

回复 CELIANGYUAN 的帖子

程序好像不完整，有些地方没有内容。
例如：;获取高程点附近的理论上存在的两根等高线高程 gc-min , gc-max
(defun c:getgc-minmax()

)

楼上能否提供完整的看看？
方便的话，能否发送一份到461045462@QQ.com
谢谢

dwjb

回复 jzj-fx72 的帖子

你那个0米3米按照变坡点生成断面的时候，cass提示你多少米内插，你输入1公里或者更大的距离，他就会按照你的变坡点来生成断面图，就是说你断面测了1公里长，内差点就大于这个距离就会按照变坡点绘制断面。用坐标法测的断面可以编程反算，但是外业必须编码左A右b桩号同中庄，回来把中平坐标加上，方位角反算，中桩到上一个中桩的方位角减去横断点到中桩的方位角，大于180为左，小于为右，排序按照断面到中桩的距离排序，然后循环下一个断面，

dwjb

回复 sunyang98 的帖子

统计的面积和list，area统计的面积有差异，误差，很大的