南方CASS 内插高程点程序
题外话，买不起安卓，刚下载了一个U盘版的安装系统 马上试验试验嘿嘿;;;根据等高线内插高程点
;;;2012年4月23日 16:11:45
;;;收集整理by明镜亦非台
;;;必须在南方CASS平台使用
;;;欢迎测试使用 求精简程序
(defun c:nc(/ *ERROR* os p1 p2 h1 h2 dh ds ss pz dd z data)
(prompt "\n根据等高线内插高程点 原理和测绘程序集成软件上的一样 内插完成后需执行CASS的命令---合并打散的高程点")
(defun 2w (dd)(list (car dd)(cadr dd) 0.0))
(defun *ERROR* (MSG)
(if OS(setvar "osmode" os))
(if ss(command "erase" ss ""))
(princ)
)
(setq os (getvar 'osmode))
(setvar 'cmdecho 0)
(command "undo" "be")
(while
(SETVAR "OSMODE" 512)
(setq p1 (getpoint "\n捕捉第一条等高线上一点: ")
h1 (caddr p1)) ;返回p1的z 值
(if (/= h1 0.0)
(progn
(setq p2 (getpoint p1 "\n捕捉第二条等高线: ")
h2 (caddr p2) ;返回p2的z 值
dh (- h2 h1) ;返回p1 p2的高差
ds (distance (2w p1) (2w p2));返回p1 p2之间2w距离
);setq
(if (= h2 0.0)(progn(exit)))
(command "line" "non" p1 "non" p2 "")
(setq ss (entlast))
(setq pz (getpoint "\n指定内插点: "))
(if(/= (caddr pz) 0.0);如果内插点在等高线上，就不计算
(setq z (caddr pz))
(progn
(setq dd (distance (2w p1) (2w pz)) ;返回p1 pt之间2w距离
dw (/ (* dh dd) ds) ;返出p1pt高差
z(+ h1 dw) ;p1的高程与p1和pt的高差之
);setq
));if progn
(setq pz (list (car pz) (cadr pz) z));定义当前高
;;以上是计算新高程，一下生成新高程点
(command "insert" "gc200" "non" pz "0.5" "0.5" "0")
(setq data(entget(entlast)))
(setq data(append (list '(-3 ("SOUTH" (1000 . "202101")))) data))
(setq data(subst '(8 . "GCD") (assoc 8 data) data))
(entmod data)
(entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") '(62 . 256) '(40 . 1) '(41 . 0.8) '(50 . 0.0)(cons 8 "GCD")(cons 7 "hz")
(cons 1 (rtos z 2 2))
'(-3 ("SOUTH" (1000 . "202111")))
(cons 10 (mapcar '+ pz '(0.50 -0.50 0)))) )
(command "erase" ss "")
);progn
(prompt "\n选择出错 Z值为0")
);if
);while
(setvar "osmode" os)
(command "undo" "e")
(princ)
) ;defun
461045462 发表于 2012-7-21 17:34 static/image/common/back.gif
您提到的：判断等高线是否闭合能解决这种问题
但是图形中，时常等高线是不闭合的
谢谢！
如果不考虑搜索范围的话那只能针对所有等高线了，但是这样的话程序运行效率未免有些低，还有我对你说的同高回合线不是太理解，另外你可不可以把你在实际用的时候处理不正确的情况给罗列一下，最好有个附图，我想只要理论上能行就一定能解决！ 自顶一下 好久没来晃ID差颗米记不得鸟 附件一样的 就不要下载了哈 本来想收B1000的但貌似只能卖到2个 回复一下激情就加5我不是挣了15个啦 呵呵 原来要间隔30S才发第2条 本帖最后由 yshf 于 2012-4-23 18:50 编辑
结果与下面操作后得到的结果一致吗?
(1)工程应用→等高线生成数据文件(abcd.dat)
(2)等高线→查询指定点高程(选择文件abcd.dat) 本帖最后由 soly2006 于 2012-6-8 13:50 编辑
yshf 发表于 2012-4-23 18:49 static/image/common/back.gif
结果与下面操作后得到的结果一致吗?
(1)工程应用→等高线生成数据文件(abcd.dat)
(2)等高线→查询指定点高 ...
虽然结果差不多，但是可以不用事先生成数据文件，为了加几个点，用生成数据文件搞有点小题大做了。
楼主这程序生成等高线与cass生成的不一样啊，点与高程值不是一个块。
看看好用吗？？？
也发个内插的吧，不需要选等高线(defun c:tqgc(/ BZ DGJ DGX1 DGX2 DGXGS EL1 EL2 EN GC1 GC2 H J JLB SS SSJL VLA XHB YSZB ZJD ZJDZB ZXZB);对等高线附近位置进行高程注记
(setq ssjl(getint"\n请输入搜索距离："))
(setq ss(ssget"x"'((0 . "POLYLINE")(8 . "DGX")))j -1);建立重量线选择集
(if ss(command"tolwpoly"ss""));将全部重量线转为轻量线
(while (setq zjd(getpoint"\n请选择注记点位置："))
(setq zjd(list(car zjd)(cadr zjd)));三维点转换为二维点
(setq yszb(list(+ ssjl (car zjd))(+ ssjl (cadr zjd)))zxzb(list(- (car zjd)ssjl)(- (cadr zjd)ssjl)));构造搜索范围框
(setq ss(ssget "c"yszb zxzb'((0 . "lwpolyline")(8 . "dgx")))jlb'()j -1)
(if (and ss(>= (setq dgxgs(sslength ss))2))
(progn
(repeat dgxgs
(setq en(ssname ss(setq j(1+ j))))
(setq vla(vlax-ename->vla-object en));转换成vla对象
(setq zjdzb(vlax-curve-getClosestPointTo vla zjd));获得离注记点最近的曲线上的
(setq jlb(cons (list (distance zjd zjdzb)en)jlb));构造图元名和相应距离表
)
(setq xhb(VL-SORT-Ijlb'(lambda(x y)(< (car x)(car y)))));返回按距离从小到大排序后的表
(setq dgx1(cadr(nth(car xhb)jlb))dgx2(cadr(nth(cadr xhb)jlb)));返回离注记点最近的两条等高线
(setq el1(entget dgx1)el2(entget dgx2))
(setq gc1(cdr(assoc 38 el1))gc2(cdr(assoc 38 el2)))
(setq bz(/ (car(nth(car xhb)jlb))(+ (car(nth(car xhb)jlb))(car(nth(cadr xhb)jlb)))));获得两距离比值
(setq dgj(- gc2 gc1))
(setq h (+ gc1 (* dgj bz)))
(command "drawgcd" "" zjd h "")
)
(alert"没有找到等高线！")
)
)
(alert"注记完毕")
(princ)
)
好东西...学习了