参考了两个程序，编出了等高线间内插高程点的程序
;此程序在CASS下运行
(defun c:nc ()
(defun 2w (qq) (list (car qq)(cadr qq) 0.0))  
(command "osnap" "endp")             ;捕捉端点
  (setq p1 (getpoint "\n捕捉第一根等高线上一点: ")
        p2 (getpoint "\n捕捉另一等高线上一点: ")
        h1 (caddr p1)                  ;返回p1的z 值
        h2 (caddr p2)                  ;返回p2的z 值
        dh (- h2 h1)                   ;返回p1 p2的高差
        ds (distance (2w p1) (2w p2))  ;返回p1 p2之间2w距离
   )
  (command "osnap" "non")              ;取消捕捉
  (setq pz (getpoint "\n指定内插高程点: "))
  (while pz
    (setq d1 (distance (2w p1) (2w pz))    ;返回p1 pz之间2w距离
          dw (/ (* dh d1) ds)              ;返出p1pz高差
          z  (+ h1 dw)                     ;p1的高程与p1和pz的高差之和
          )
    (setq pz (list (car pz) (cadr pz) z))  ;定义当前高
     (command "dd" "202101"  "1" pz  ""  )   ;设置地物编码202101一般高程点
    )
  (princ)
)
点评回复 使用道具 评分 举报
sy100

金牌会员


帖子215通道币0 个明经币2 个
串个门加好友打招呼发消息	
14#
 发表于 2011-2-26 11:22:51 |只看该作者
本帖最后由 sy100 于 2011-2-26 11:25 编辑


谢谢xuexicad1960 ！
本人也需要这样的程序。
能否将操作过程再简化一点呢，就是将程序加载并输入命令之后提示：捕捉第一根等高线上一点→捕捉另一等高线上一点→指定内插高程点。当高程点插入之后再提示：捕捉第一根等高线上一点→捕捉另一等高线上一点→指定内插高程点。如此自动循环， 按Esc键结束。
点评回复 使用道具 评分 举报
xuexicad1960

高级会员


帖子55通道币0 个明经币3 个
串个门加好友打招呼发消息	
15#
 发表于 2011-2-26 23:15:00 |只看该作者
回复 sy100 的帖子

你说的要自动循环， 按Esc键结束。我当时是考虑了写高程时，注记的大小和图的比例尺还有关系，就借用了cass中“dd”命令。dd在写高程时是连续的 ，我试着想加两个回车，让程序重新回到
命令提示符下，没有办到。现在只能手动回车再继续了，如有高手帮忙再完善一下这个程序，或按照这样的需求再写一个程序，我会非常高兴和大家一起探讨。
点评回复 使用道具 评分 举报
461045462

钻石会员


帖子770通道币0 个明经币0 个
串个门加好友打招呼发消息	
16#
 发表于 2011-3-4 06:38:15 |只看该作者
本帖最后由 461045462 于 2011-3-4 06:40 编辑


将13楼的修改了部分，还是在cass下运作，感觉欠理想。我想让它在cad下直接操作，却没有做到，如果采用text方式要如何修改？望高手指教。
谢谢

(defun c:jgc1 (/ p1 p2 h1 h2 dh ds pz d1 z) ;等高线之间加高程值 
  (setvar "cmdecho" 0)
  (defun 2w (qq) (list (car qq) (cadr qq) 0.0))
  (SETVAR "OSMODE" 512)
  (setq        p1 (getpoint "\n捕捉第一根等高线上一点: ")
        p2 (getpoint "\n捕捉另一等高线上一点: ")
        h1 (caddr p1)                        ;返回p1的z 值
        h2 (caddr p2)                        ;返回p2的z 值
        dh (- h2 h1)                        ;返回p1 p2的高差
        ds (distance (2w p1) (2w p2))        ;返回p1 p2之间2w距离
  )
  (setvar "osmode" 0)
  (setq pz (getpoint "\n指定内插高程点: "))
  (setq        d1 (distance (2w p1) (2w pz))        ;返回p1 pz之间2w距离
        dw (/ (* dh d1) ds)                ;返出p1pz高差
        z  (+ h1 dw)                        ;p1的高程与p1和pz的高差之和
  )
  (setq pz (list (car pz) (cadr pz) z))        ;定义当前高
  (command "dd" "202101" "1" pz "" "")        ;设置地物编码202101一般高程点

  ;(command "text" "j" "ml" "1" "0" (rtos pz 2 2))
;用text命令语句要如何修改

  (SETVAR "OSMODE" 512)
  (princ)
  (c:jgc1)
)

点评回复 使用道具 评分 举报
xuexicad1960

高级会员


帖子55通道币0 个明经币3 个
串个门加好友打招呼发消息	
17#
 发表于 2011-4-18 16:49:47 |只看该作者
回复 sy100 的帖子

经过一段时间的使用和学习，又把“内插高程点”的程序修改了一下，基本达到你说的要求，击右键或空格键退出，同时取消捕捉。欢迎提意见，共同学习。附程序如下：
;在CASS下运行，同时注意 确定内插高程点不要离捕捉的两点连线太远
(defun c:nc (/ p1 p2 h1 h2 dh ds pz dd z)
  (defun 2w (dd)(list (car dd)(cadr dd) 0.0))
  (SETVAR "OSMODE" 512)
   (while
   (setq p1 (getpoint "\n捕捉第一根等高线上一点: ")
         h1 (caddr p1))                  ;返回p1的z 值
    (if (/= h1 0.0 )
    (progn
    (setq p2 (getpoint "\n捕捉另一等高线上一点: ")
        h2 (caddr p2)                  ;返回p2的z 值
        dh (- h2 h1)                   ;返回p1 p2的高差
        ds (distance (2w p1) (2w p2))  ;返回p1 p2之间2w距离
    )
    (setvar "osmode" 0)
    (setq pz (getpoint "\n确定内插高程点: "))
    (setq dd (distance (2w p1) (2w pz))    ;返回p1 pt之间2w距离
          dw (/ (* dh dd) ds)              ;返出p1pt高差
          z  (+ h1 dw)                     ;p1的高程与p1和pt的高差之
     )
    (setq pz (list (car pz) (cadr pz) z))  ;定义当前高
    (command "dd" "202101"  "1" pz "" "")  ;设置地物编码202101一般高程点
    )
   )
   (SETVAR "OSMODE" 512)
   )
   (setvar "osmode" 0)
   (princ)
    )