南方CASS 内插高程点程序

yanshengjiang

题外话，买不起安卓，刚下载了一个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

changyiran

461045462 发表于 2012-7-21 17:34
您提到的：判断等高线是否闭合能解决这种问题
但是图形中，时常等高线是不闭合的
谢谢！

如果不考虑搜索范围的话那只能针对所有等高线了，但是这样的话程序运行效率未免有些低，还有我对你说的同高回合线不是太理解，另外你可不可以把你在实际用的时候处理不正确的情况给罗列一下，最好有个附图，我想只要理论上能行就一定能解决！

yanshengjiang

自顶一下 好久没来晃  ID差颗米记不得鸟

yanshengjiang

附件一样的 就不要下载了哈 本来想收B1000的  但貌似只能卖到2个

yanshengjiang

回复一下激情就加5  我不是挣了15个啦 呵呵

yanshengjiang

原来要间隔30S才发第2条

yshf

结果与下面操作后得到的结果一致吗?
(1)工程应用→等高线生成数据文件(abcd.dat)
(2)等高线→查询指定点高程(选择文件abcd.dat)

soly2006

yshf 发表于 2012-4-23 18:49
结果与下面操作后得到的结果一致吗?
(1)工程应用→等高线生成数据文件(abcd.dat)
(2)等高线→查询指定点高 ...

虽然结果差不多，但是可以不用事先生成数据文件，为了加几个点，用生成数据文件搞有点小题大做了。

楼主这程序生成等高线与cass生成的不一样啊，点与高程值不是一个块。

shxm112233

看看好用吗？？？

changyiran

也发个内插的吧，不需要选等高线

2. (defun c:tqgc(/ BZ DGJ DGX1 DGX2 DGXGS EL1 EL2 EN GC1 GC2 H J JLB SS SSJL VLA XHB YSZB ZJD ZJDZB ZXZB);对等高线附近位置进行高程注记
   
3.   (setq ssjl(getint"\n请输入搜索距离："))
   
4.   (setq ss(ssget"x"'((0 . "POLYLINE")(8 . "DGX")))j -1);建立重量线选择集
   
5.   (if ss(command"tolwpoly"ss""));将全部重量线转为轻量线
   
6.   (while (setq zjd(getpoint"\n请选择注记点位置："))
   
7.        (setq zjd(list(car zjd)(cadr zjd)));三维点转换为二维点
   
8.        (setq yszb(list(+ ssjl (car zjd))(+ ssjl (cadr zjd)))zxzb(list(- (car zjd)ssjl)(- (cadr zjd)ssjl)));构造搜索范围框
   
9.        (setq ss(ssget "c"yszb zxzb'((0 . "lwpolyline")(8 . "dgx")))jlb'()j -1)
   
10.        (if (and ss(>= (setq dgxgs(sslength ss))2))
    
11.        (progn
    
12.          (repeat dgxgs
    
13.      (setq en(ssname ss(setq j(1+ j))))
    
14.      (setq vla(vlax-ename->vla-object en));转换成vla对象
    
15.      (setq zjdzb(vlax-curve-getClosestPointTo vla zjd));获得离注记点最近的曲线上的
    
16.      (setq jlb(cons (list (distance zjd zjdzb)en)jlb));构造图元名和相应距离表
    
17.          )
    
18.          (setq xhb(VL-SORT-I  jlb'(lambda(x y)(< (car x)(car y)))));返回按距离从小到大排序后的表
    
19.          (setq dgx1(cadr(nth(car xhb)jlb))dgx2(cadr(nth(cadr xhb)jlb)));返回离注记点最近的两条等高线
    
20.          (setq el1(entget dgx1)el2(entget dgx2))
    
21.          (setq gc1(cdr(assoc 38 el1))gc2(cdr(assoc 38 el2)))
    
22.          (setq bz(/ (car(nth(car xhb)jlb))(+ (car(nth(car xhb)jlb))(car(nth(cadr xhb)jlb)))));获得两距离比值
    
23.          (setq dgj(- gc2 gc1))
    
24.          (setq h (+ gc1 (* dgj bz)))
    
25.          (command "drawgcd" "" zjd h "")
    
26.        )
    
27.        (alert"没有找到等高线！")
    
28.    )
    
29.   )
    
30.   (alert"注记完毕")
    
31.   (princ)
    
32. )

(defun c:tqgc(/ BZ DGJ DGX1 DGX2 DGXGS EL1 EL2 EN GC1 GC2 H J JLB SS SSJL VLA XHB YSZB ZJD ZJDZB ZXZB);对等高线附近位置进行高程注记<br />   (setq ssjl(getint"\n请输入搜索距离："))<br />   (setq ss(ssget"x"'((0 . "POLYLINE")(8 . "DGX")))j -1);建立重量线选择集<br />   (if ss(command"tolwpoly"ss""));将全部重量线转为轻量线<br />   (while (setq zjd(getpoint"\n请选择注记点位置："))<br />        (setq zjd(list(car zjd)(cadr zjd)));三维点转换为二维点<br />        (setq yszb(list(+ ssjl (car zjd))(+ ssjl (cadr zjd)))zxzb(list(- (car zjd)ssjl)(- (cadr zjd)ssjl)));构造搜索范围框<br />        (setq ss(ssget "c"yszb zxzb'((0 . "lwpolyline")(8 . "dgx")))jlb'()j -1)<br />        (if (and ss(>= (setq dgxgs(sslength ss))2))<br />        (progn<br />          (repeat dgxgs<br />      (setq en(ssname ss(setq j(1+ j))))<br />      (setq vla(vlax-ename->vla-object en));转换成vla对象<br />      (setq zjdzb(vlax-curve-getClosestPointTo vla zjd));获得离注记点最近的曲线上的<br />      (setq jlb(cons (list (distance zjd zjdzb)en)jlb));构造图元名和相应距离表<br />          )<br />          (setq xhb(VL-SORT-I  jlb'(lambda(x y)(< (car x)(car y)))));返回按距离从小到大排序后的表<br />          (setq dgx1(cadr(nth(car xhb)jlb))dgx2(cadr(nth(cadr xhb)jlb)));返回离注记点最近的两条等高线<br />          (setq el1(entget dgx1)el2(entget dgx2))<br />          (setq gc1(cdr(assoc 38 el1))gc2(cdr(assoc 38 el2)))<br />          (setq bz(/ (car(nth(car xhb)jlb))(+ (car(nth(car xhb)jlb))(car(nth(cadr xhb)jlb)))));获得两距离比值<br />          (setq dgj(- gc2 gc1))<br />          (setq h (+ gc1 (* dgj bz)))<br />          (command "drawgcd" "" zjd h "")<br />        )<br />        (alert"没有找到等高线！")<br />    )<br />   )<br />   (alert"注记完毕")<br />   (princ)<br /> )

xujinhua

好东西...学习了