想写一个等高线内插的小程序，思路不太清晰，求达人提点

mrhvslisp

处理等高线的情况太多了

CASS自带的等高线内插太蹩脚了

想自己写个等高线内插程序

希望两条等高线中间内插一条等高线就OK了，

求达人给个构思。

阿然

我有个想法，没实践过，获取两条等高线的长度，然后按照等比例步长用(vlax-curve-getPointAtDist curve-objdist)获取在两条等高线的点，然后取这两个点的中点，得到一串点表，根据这些点表绘制polyline

1. (vl-load-com)
   
2. (setq *AcadDoc* (vla-get-ActiveDocument (vlax-get-Acad-Object)))
   
3. (setq *MoSpace* (vla-get-ModelSpace *AcadDoc*))
   
4. 
   
5. (defun c:dgx-insert (/        pline1   pline2  len1   len2
   
6.          step     step1    step2  i   pt
   
7.          pt1      pt2      ptlist  ptlistlen
   
8.          ptsafearray elev1 elev2 elev newpline
   
9.         )
   
10.   (if (setq pline1 (vlax-ename->vla-object
    
11.          (car (entsel "\n选择第一条等高线:"))
    
12.        )
    
13.       )
    
14.     (if  (setq pline2 (vlax-ename->vla-object
    
15.            (car (entsel "\n选择第二条等高线:"))
    
16.          )
    
17.   )
    
18.       (progn
    
19.   (setq len1 (vlax-get-property pline1 'length)
    
20.         len2 (vlax-get-property pline2 'length)
    
21.         elev1 (vlax-get-property pline1 'Elevation )
    
22.         elev2 (vlax-get-property pline2 'Elevation )
    
23.         elev (/ (+ elev1 elev2) 2)
    
24.   )
    
25.   (if (setq step (getint "\n请输入内插步长:"))
    
26.     (setq  step1 (/ len1 step)
    
27.     step2 (/ len2 step)
    
28.     i     0
    
29.     )
    
30.   )
    
31.   (while (<= i step)
    
32.     (setq  pt1 (vlax-curve-getPointAtDist pline1 (* i step1))
    
33.     pt2 (vlax-curve-getpointatdist pline2 (* i step2))
    
34.     )
    
35.     (setq pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) pt1 pt2))
    
36.     (setq ptlist (append ptlist pt))
    
37.     (setq i (1+ i))
    
38.   )
    
39.   (setq ptlistlen (1- (length ptlist)))
    
40.   (setq ptsafearray
    
41.          (vlax-make-safearray
    
42.      vlax-vbdouble
    
43.      (cons 0 ptlistlen)
    
44.          )
    
45.   )
    
46.   (setq ptsafearray (vlax-safearray-fill ptsafearray ptlist))
    
47.   (setq newpline (vla-AddPolyline *mospace* ptsafearray))
    
48.   (vlax-put-property newpline 'Elevation elev)
    
49.       )
    
50.     )
    
51.   )
    
52. )

(vl-load-com)<br /> (setq *AcadDoc* (vla-get-ActiveDocument (vlax-get-Acad-Object)))<br /> (setq *MoSpace* (vla-get-ModelSpace *AcadDoc*))<br /> <br /> (defun c:dgx-insert (/        pline1   pline2  len1   len2<br />          step     step1    step2  i   pt<br />          pt1      pt2      ptlist  ptlistlen<br />          ptsafearray elev1 elev2 elev newpline<br />         )<br />   (if (setq pline1 (vlax-ename->vla-object<br />          (car (entsel "\n选择第一条等高线:"))<br />        )<br />       )<br />     (if  (setq pline2 (vlax-ename->vla-object<br />            (car (entsel "\n选择第二条等高线:"))<br />          )<br />   )<br />       (progn<br />   (setq len1 (vlax-get-property pline1 'length)<br />         len2 (vlax-get-property pline2 'length)<br />         elev1 (vlax-get-property pline1 'Elevation )<br />         elev2 (vlax-get-property pline2 'Elevation )<br />         elev (/ (+ elev1 elev2) 2)<br />   )<br />   (if (setq step (getint "\n请输入内插步长:"))<br />     (setq  step1 (/ len1 step)<br />     step2 (/ len2 step)<br />     i     0<br />     )<br />   )<br />   (while (<= i step)<br />     (setq  pt1 (vlax-curve-getPointAtDist pline1 (* i step1))<br />     pt2 (vlax-curve-getpointatdist pline2 (* i step2))<br />     )<br />     (setq pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) pt1 pt2))<br />     (setq ptlist (append ptlist pt))<br />     (setq i (1+ i))<br />   )<br />   (setq ptlistlen (1- (length ptlist)))<br />   (setq ptsafearray<br />          (vlax-make-safearray<br />      vlax-vbdouble<br />      (cons 0 ptlistlen)<br />          )<br />   )<br />   (setq ptsafearray (vlax-safearray-fill ptsafearray ptlist))<br />   (setq newpline (vla-AddPolyline *mospace* ptsafearray))<br />   (vlax-put-property newpline 'Elevation elev)<br />       )<br />     )<br />   )<br /> )

kaokao5230

CASS内插处理起来真的太费力了，等高线生成之后要处理的问题太多了。

DCMZ

阿然 发表于 2012-12-8 10:02
我有个想法，没实践过，获取两条等高线的长度，然后按照等比例步长用(vlax-curve-getPointAtDist curve-obj ...

这思路很赞

yarp

http://bbs.mjtd.com/thread-95698-1-1.html
我用arx写的，用lisp的可能太慢了。
我的坐标计算器中也集成了这个功能，基本上可以在所有版本cad中用。
基本思路就是从中线上向前搜索，找到下一个点，该点分别到两根线的最近距离相等或为一定比例，再继续向前搜索。
所附的dwg文件是内插出来的效果，中间的是内插线。

阿然

附上代码，2004测试通过

chbddzx12

还是不太智能化。。。

luojie110

非常感谢！

三涂彼岸

直接等比例插线并不符合实际地形，某一段可能离两条线的距离相等，另一段可能离一条线近点，离另一条远些，地形平缓的时候甚至走向都与旁边两条等高线迥异，按比例插线局限太大。

20060510412

阿然 发表于 2012-12-8 10:02
我有个想法，没实践过，获取两条等高线的长度，然后按照等比例步长用(vlax-curve-getPointAtDist curve-obj ...

代码运行的时候出错了