changyiran 发表于 2012-7-20 18:48 static/image/common/back.gif
我的这个程序其实是针对两条等高线之间的点的高程注记来编写的，所以你的这个问题不好解决，希望你能想出 ...
谢谢changyiran
理解您的程序是针对两条等高线之间的点的高程所求，只是一直没有找到好的方式，所以提及试试。
谢谢！
本帖最后由 461045462 于 2012-7-20 22:18 编辑
changyiran 发表于 2012-7-18 12:39 http://bbs.mjtd.com/static/image/common/back.gif
这个符合你的要求，距离100是足够了，不管是拟不拟合也都行，你试下！
试了试，发现程序高程标注有误。
麻烦看看。
谢谢！
461045462 发表于 2012-7-20 22:12 static/image/common/back.gif
试了试，发现程序高程标注有误。
麻烦看看。
谢谢！
这确实是个问题，我这个程序的基本思想是根据指定距离构建一个矩形框，将与矩形框相交的所有等高线根据其到指定注记位置的距离进行排序，认为指定注记位置两侧的等高线应该就是距离最近的两条等高线，然后以此来实现高程内插，但是根据你的提醒我发现我的这个想法有点想当然，正如你指出的这两个错误，就不符合“注记位置两侧的等高线应该就是距离最近的两条等高线”这个要求，因而出错，我想这个应该有解决办法。
461045462 发表于 2012-7-20 22:12 static/image/common/back.gif
试了试，发现程序高程标注有误。
麻烦看看。
谢谢！
我想到了一个解决思路，离注记位置最近的那一条等高线肯定是该位置两侧的两条等高线中的一条，那么就根据这条等高线上离注记位置最近的那个点与注记位置这两点构造一射线（要有一定长度，保证有等高线与之相交），那么与该射线相交的等高线中离注记位置最近的那个等高线必是注记位置两侧的另外一条等高线，我试着编下。
461045462 发表于 2012-7-20 22:12 static/image/common/back.gif
试了试，发现程序高程标注有误。
麻烦看看。
谢谢！
这是修改后的代码，顺便把山顶问题也给解决了(defun c:tqgc(/ BZ DGJ DGX1 DGX2 DGXGS EL1 EL2 EN GC1 GC2 H J JLB SS SSJL VLA XHB YSZB ZJD ZJDZB ZXZB DEZB DYZB JL1 JL2);对等高线附近位置进行高程注记
(princ"\n欢迎使用-----河南中化常怡然！")
(setq ssjl 50)
(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 . "*polyline")(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)zjdzb en)jlb));构造距离和相应最近点坐标表
)
(setq xhb(VL-SORT-Ijlb'(lambda(x y)(< (car x)(car y)))));返回按距离从小到大排序后的表
(setq jl1(car(nth(car xhb)jlb))gc1(caddr(cadr(nth(car xhb)jlb))))
(setq dyzb(cadr(nth(car xhb)jlb)));返回离注记点最近的等高线上离注记点最近的点的坐标
(setq dezb(polar zjd(angle dyzb zjd)100));根据dyzb与注记点连线的夹角返回离zjd距离值为50的点的坐标
(setq ss(ssget"f"(list zjd dezb)'((0 . "*polyline")(8 . "dgx")))jlb'()j -1)
(if ss
(progn
(repeat(sslength ss)
(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)zjdzb)jlb));构造距离和相应最近点坐标表
)
(setq xhb(VL-SORT-Ijlb'(lambda(x y)(< (car x)(car y)))))
(setq jl2(car(nth(car xhb)jlb))gc2(caddr(cadr(nth(car xhb)jlb))))
(if (= gc1 gc2)
(command "drawgcd" "" zjd gc1 "");山顶或山底
(progn
(setq bz(/ jl1 (+ jl1 jl2)));获得两距离比值
(setq dgj(- gc2 gc1))
(setq h (+ gc1 (* dgj bz)))
(command "drawgcd" "" zjd h "")
)
)
)
(alert"注记点另外一侧无等高线")
)
)
(alert"没有找到等高线！")
)
)
(alert"注记完毕")
(princ)
)有一种情况会注记错，就是当离注记点最近的一条等高线有回转时，正好构造的射线与该等高线回转的那一部分有交点，这时高程注记值等于等高线的高程值，也就是说是按山顶或山脚处理的，本来利用射线与曲线的交点能完美的解决这一点，但是我发现用vla-intersectwith无法求直线与二维多段线的交点（如果是多段线就可以），所有我暂时没有这样解决，虽然判断等高线是否闭合能解决这种问题，但是治标不治本，当最近的和第二近的等高线都回转时并且分布在注记点同一侧时照样出错，所以用时要考虑到这一点，我再想想有没有更好的解决办法。
changyiran 发表于 2012-7-21 13:53 static/image/common/back.gif
这是修改后的代码，顺便把山顶问题也给解决了有一种情况会注记错，就是当离注记点最近的一条等高线有回转 ...
谢谢changyiran ！
先下载试试。
谢谢您一再的修改，辛苦了。
谢谢！
changyiran 发表于 2012-7-21 13:53 static/image/common/back.gif
这是修改后的代码，顺便把山顶问题也给解决了有一种情况会注记错，就是当离注记点最近的一条等高线有回转 ...
试了后，觉得较理想。
觉得：采用 构造搜索范围框的方式欠佳，如果调出程序，能不考虑范围就比较方便。
您说的1000米，或许范围够大了；是较大了。然而我去年就有30~50平方公里的等高线图形合并在一起检查。
我收集了一个加注高程的程序，只对拟合线有效，没有范围的限制；缺点是山顶与同高回合线部位处理不到位。但程序是.fas，无法修改。
您这样对多段线也有效，比较方便。
谢谢了！
本帖最后由 461045462 于 2012-7-21 17:34 编辑
changyiran 发表于 2012-7-21 13:53 http://bbs.mjtd.com/static/image/common/back.gif
这是修改后的代码，顺便把山顶问题也给解决了有一种情况会注记错，就是当离注记点最近的一条等高线有回转 ...
您提到的：判断等高线是否闭合能解决这种问题
但是图形中，时常等高线是不闭合的
谢谢！
461045462 发表于 2012-7-21 17:34 static/image/common/back.gif
您提到的：判断等高线是否闭合能解决这种问题
但是图形中，时常等高线是不闭合的
谢谢！
如果不考虑搜索范围的话那只能针对所有等高线了，但是这样的话程序运行效率未免有些低，还有我对你说的同高回合线不是太理解，另外你可不可以把你在实际用的时候处理不正确的情况给罗列一下，最好有个附图，我想只要理论上能行就一定能解决！
本帖最后由 changyiran 于 2012-7-21 21:22 编辑
461045462 发表于 2012-7-21 17:27 http://bbs.mjtd.com/static/image/common/back.gif
试了后，觉得较理想。
觉得：采用 构造搜索范围框的方式欠佳，如果调出程序，能不考虑范围就比较方便。 ...
(defun dgxjd(sxen dgxen / EL GCZB JDZB VLA VLA1);求射线与等高线之间的交点
(setq vla1(vlax-ename->vla-object sxen)vla(vlax-ename->vla-object dgxen))
(setq el(entget dgxen))
(if(=(cdr(assoc 0 el))"POLYLINE")
(progn
(setq gczb(assoc 10 el));含有高程的子表
(setq el(subst '(10 0 0)gczb el))
(entmod el)
(setq jdzb(vlax-invoke vla1'IntersectWith vla 0))
(setq el(subst gczb(assoc 10 el)el))
(entmod el)
(setq jdzb (list(car jdzb)(cadr jdzb)(last gczb)))
)
(progn
(setq gczb(assoc 38 el));含有高程的子表
(setq el(subst '(38 . 0)gczb el))
(entmod el)
(setq jdzb(vlax-invoke vla1'IntersectWith vla 0))
(setq el(subst gczb(assoc 38 el)el))
(entmod el)
(setq jdzb (list(car jdzb)(cadr jdzb)(cdr gczb)))
)
)
)
(defun c:tqgc(/ BZ DGJ DGX1 DGX2 DGXGS EL1 EL2GC1 GC2 H JSS SSJL VLA XHB YSZBZJDZB ZXZBDYZB JL1 JL2 DEZB EN JDZB JLB SXEN VLA1 ZJD);对等高线附近位置进行高程注记
(princ"\n欢迎使用-----河南中化常怡然！")
(setq ssjl 50)
(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 . "*polyline")(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)zjdzb en)jlb));构造距离和相应最近点坐标表
)
(setq xhb(VL-SORT-Ijlb'(lambda(x y)(< (car x)(car y)))));返回按距离从小到大排序后的表
(setq jl1(car(nth(car xhb)jlb))gc1(caddr(cadr(nth(car xhb)jlb))))
(setq dyzb(cadr(nth(car xhb)jlb)));返回离注记点最近的等高线上离注记点最近的点的坐标
(setq dezb(polar zjd(angle dyzb zjd)100));根据dyzb与注记点连线的夹角返回离zjd距离值为50的点的坐标
(entmake(list'(0 . "line")(list 10(car zjd)(cadr zjd))(list 11(car dezb)(cadr dezb))))
(setq sxen(entlast))
(setq vla1(vlax-ename->vla-object sxen))
(setq ss(ssget"f"(list zjd dezb)'((0 . "*polyline")(8 . "dgx")))jlb'()j -1)
(if ss
(progn
(repeat(sslength ss)
(setq en(ssname ss(setq j(1+ j))))
(setq vla(vlax-ename->vla-object en));转换成vla对象
(setq jdzb(dgxjd sxen en));获得射线与曲线的交点坐标
(setq jlb(cons (list (distance zjd jdzb)jdzb vla)jlb));构造距离和相应交点坐标、vla对象表
)
(entdel sxen);删除辅助射线
(setq xhb(VL-SORT-Ijlb'(lambda(x y)(< (car x)(car y)))))
(setq jl2(distance(vlax-curve-getClosestPointTo (caddr(nth(car xhb)jlb)) zjd)zjd)gc2(caddr(cadr(nth(car xhb)jlb))))
(if(/= jl1 0)
(progn
(setq bz(/ jl1 (+ jl1 jl2)));获得两距离比值
(setq dgj(- gc2 gc1))
(setq h (+ gc1 (* dgj bz)))
)
(setq h gc1)
)
(command "drawgcd" "" zjd h "")
)
(alert"注记点另外一侧无等高线")
)
)
(alert"没有找到等高线！")
)
)
(alert"注记完毕")
(princ)
)这个把等高线回转的也解决了，原来是因为直线与等高线不共面才求不到交点的，因此专门编个函数来求等高线与射线的交点，试验下，如果有什么问题再交流。