（测试）[[编程申请]：如何在两条已赋值的等高线间内插4条等高线

lsy · 发表于 2003-6-8 10:50:39

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如已赋值的两条等高线分别为1250和1255，如何在两条之间内插1251、1252、1253、1254这四条等高线

XDSoft · 发表于 2003-6-8 10:56:46

最初由 lsy 发布
[B]如已赋值的两条等高线分别为1250和1255，如何在两条之间内插1251、1252、1253、1254这四条等高线 [/B]

你贴个图吧, 由于不是该专业,很多操作不理解, 你详细说下内插的原则和方法.

lsy · 发表于 2003-6-8 11:15:19

原则就是在两条已赋值的等高线和内插的四条线，它们间距在每一段上大致相等，（由于已赋值的两条线它们的间距在每一段都不是相等的，如果是相等的就可以用偏移功能）

鹰博长空 · 发表于 2003-6-8 11:23:37

我来贴个图吧，就是在40米线和45米线间求41、42、43、44米线

eachy · 发表于 2003-6-8 11:31:26

最初由 lsy 发布
[B]原则就是在两条已赋值的等高线和内插的四条线，它们间距在每一段上大致相等，（由于已赋值的两条线它们的间距在每一段都不是相等的，如果是相等的就可以用偏移功能） [/B]

是图中的要求吗？

lsy · 发表于 2003-6-8 12:42:25

对，大概就是象那种，不过红色的线每条都需大致垂直其它条

eachy · 发表于 2003-6-9 18:52:34

最初由 lsy 发布
[B]对，大概就是象那种，不过红色的线每条都需大致垂直其它条 [/B]

抛砖引玉，写了个简单的。

;;本程序仅能完成简单的等高线插值
;; 1 曲线的方向必须一致，如果出错请先对其中的一个曲线使用用工具箱的曲线反向 ;
;; 2 程序对曲线的凹凸比较大的处理结果未知，自行测试;
;; 程序中的模拟段数默认100等分，可以根据曲线的长短自行设置 $xdtb_globle_divnum
(if (not $xdtb_globle_divnum)
(setq $xdtb_globle_divnum 100.)
)
(defun c:XDTB_InsCU (/ ll e1 e2 v tf plst pl $two_point_divideby)
(defun $two_point_divideby (pl1 pl2 n / pl pl0 c plst)
(if (= (length pl1) (length pl2))
(progn
(setq pl (mapcar '(lambda (x y) (list x y)) pl1 pl2))
(setq
pl0 (mapcar
'(lambda (x / p1 p2 dis ang pt ptl)
(setq p1 (car x)
p2 (cadr x)
)
(setq dis (/ (distance p1 p2) n)
ang (angle p1 p2)
)
(repeat (1- n)
(if ptl
(setq ptl
(append (list (setq pt (polar p1 ang dis)))
ptl
)
)
(setq ptl (list (setq pt (polar p1 ang dis))))
)
(setq p1 pt)
)
ptl
)
pl
)
)
)
)
(setq c 0
plst '()
)
(repeat (length (car pl0))
(if plst
(setq plst
(append (list (mapcar '(lambda (x) (nth c x)) pl0)) plst)
)
(setq plst (list (mapcar '(lambda (x) (nth c x)) pl0)))
)
(setq c (1+ c))
)
plst
)
(xdrx_begin)
(xdrx_ucson)
(xdrx_sysvar_push "osmode")
(setvar "dimzin" 0)
(setq ll '((0 . "*line,arc")))
(setq e1 (xdrx_entsel "\n选择第一条曲线: "))
(setq e2 (xdrx_entsel "\n选择第二条曲线: "))
(setq v (getint "\n均分段数: "))
(if (and e1 e2)
(progn
(if
(= (car (xdrx_object_classname (car e1)))
(car (xdrx_object_classname (car e2)))
"LINE"
)
(setq tf t)
)
(setq plst (mapcar '(lambda (x)
(xdrx_getpointatdist
x
(if tf
(cadr (xdrx_getarea x))
(/ (cadr (xdrx_getarea x))
$xdtb_globle_divnum
)
)
)
)
(list (car e1) (car e2))
)
)
(setvar "osmode" 0)
(setq pl ($two_point_divideby (car plst) (cadr plst) v))
(foreach x pl
(apply 'command (cons ".pline" x))
(command)
)
)
)
(xdrx_sysvar_pop)
(xdrx_ucsoff)
(xdrx_end)
(princ)
)

;;本程序仅能完成简单的等高线插值 
;; 1 曲线的方向必须一致，如果出错请先对其中的一个曲线使用用工具箱的曲线反向 ; 
;; 2 程序对曲线的凹凸比较大的处理结果未知，自行测试; 
;; 程序中的模拟段数默认100等分，可以根据曲线的长短自行设置 $xdtb_globle_divnum 
(if (not $xdtb_globle_divnum) 
  (setq $xdtb_globle_divnum 100.) 
) 
(defun c:XDTB_InsCU (/  ll e1 e2 v tf plst pl $two_point_divideby) 
  (defun $two_point_divideby (pl1 pl2 n / pl pl0 c plst) 
    (if        (= (length pl1) (length pl2)) 
      (progn 
        (setq pl (mapcar '(lambda (x y) (list x y)) pl1 pl2)) 
        (setq 
          pl0 (mapcar 
                '(lambda (x / p1 p2 dis ang pt ptl) 
                   (setq p1 (car x) 
                         p2 (cadr x) 
                   ) 
                   (setq dis (/ (distance p1 p2) n) 
                         ang (angle p1 p2) 
                   ) 
                   (repeat (1- n) 
                     (if ptl 
                       (setq ptl 
                              (append (list (setq pt (polar p1 ang dis))) 
                                      ptl 
                              ) 
                       ) 
                       (setq ptl (list (setq pt (polar p1 ang dis)))) 
                     ) 
                     (setq p1 pt) 
                   ) 
                   ptl 
                 ) 
                pl 
              ) 
        ) 
      ) 
    ) 
    (setq c    0 
          plst '() 
    ) 
    (repeat (length (car pl0)) 
      (if plst 
        (setq plst 
               (append (list (mapcar '(lambda (x) (nth c x)) pl0)) plst) 
        ) 
        (setq plst (list (mapcar '(lambda (x) (nth c x)) pl0))) 
      ) 
      (setq c (1+ c)) 
    ) 
    plst 
  ) 
  (xdrx_begin) 
  (xdrx_ucson) 
  (xdrx_sysvar_push "osmode") 
  (setvar "dimzin" 0) 
  (setq ll '((0 . "*line,arc"))) 
  (setq e1 (xdrx_entsel "\n选择第一条曲线: ")) 
  (setq e2 (xdrx_entsel "\n选择第二条曲线: ")) 
  (setq v (getint "\n均分段数: ")) 
  (if (and e1 e2) 
    (progn 
      (if 
        (= (car (xdrx_object_classname (car e1))) 
           (car (xdrx_object_classname (car e2))) 
           "LINE" 
        ) 
         (setq tf t) 
      ) 
      (setq plst (mapcar '(lambda (x) 
                            (xdrx_getpointatdist 
                              x 
                              (if tf 
                                (cadr (xdrx_getarea x)) 
                                (/ (cadr (xdrx_getarea x)) 
                                   $xdtb_globle_divnum 
                                ) 
                              ) 
                            ) 
                          ) 
                         (list (car e1) (car e2)) 
                 ) 
      ) 
      (setvar "osmode" 0) 
      (setq pl ($two_point_divideby (car plst) (cadr plst) v)) 
      (foreach x pl 
        (apply 'command (cons ".pline" x)) 
        (command) 
      ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (princ) 
)

msdg · 发表于 2003-6-11 10:31:22

这个工具对水利水电也很有用，赶紧收藏！

lsy · 发表于 2003-6-15 19:18:10

上面的程序只能在中间画出几条直线来，而不能画出曲线来

msdg · 发表于 2003-6-16 05:13:27

简单的曲线也可以的。这个功能主要为某些局部插入等高线而设计的，太长或复杂的线当然不行。另外使用时要注意两条线的方向。

tsy_sds_chwr · 发表于 2003-10-19 16:32:57

考虑曲线就太好了,我们经常用到,太感谢

账号		自动登录	找回密码
密码			立即注册

（测试）[[编程申请]：如何在两条已赋值的等高线间内插4条等高线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [编程申请]：如何在两条已赋值的等高线间内插4条等高线