[求助]：求批量给等高线赋高程的程序

hisum · 发表于 2006-10-27 21:46:11

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

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

×

其它系统导入到CAD里的文件，等高线都没有高程值，就是标高属性值，不利于进一步的工程应用。有没有办法通过拉一条线，把经过这条线的等高线依次按给定的步长赋值？请高手指教！

david96007 · 发表于 2006-10-28 15:37:11

很久以前的东西了，自己改造一下应该可以！

(defun c:tt (/ pt pt01 pt02 pt_lst ll ss L_ss ent_l nam e gaocheng gch)
(setq pt (getpoint "点取等高线垂线第1点:")
pt01 pt
pt02 pt
pt_lst nil
)
(WHILE PT
(SETQ PT_LST (APPEND PT_LST (LIST PT))
LL (LENGTH pt_lst)
pt (getpoint (strcat "\n点取等高线垂线第"
(rtos (+ 1 ll))
"点(回车完成选择):"
)
pt
)
)
(if pt
(progn (grdraw pt02 pt 1 1) (setq pt02 pt))
)
)
(setq ss (ssget "f" pt_lst '((0 . "LINE,LWPOLYLINE,POLYLINE")))
l_ss (sslength ss)
ent_l (entget (ssname ss 0))
nam (cdr (assoc 0 ent_l))
)
(if (= nam "LWPOLYLINE")
(setq e (cdr (assoc 38 ent_l))
gaocheng (getreal
(strcat "输入第一条等高线高程<" (rtos e 2 0) ">:")
)
)
(setq e (last (assoc 10 ent_l))
gaocheng (getreal
(strcat "输入第一条等高线高程<" (rtos e 2 0) ">:")
)
)
)
(if gaocheng
()
(setq gaocheng e)
)
(setq gch (getreal "输入等高线间距<1000>:"))
(if gch
()
(setq gch 1000)
)
(setq n 0)
(while (< n l_ss)
(setq ent_l (entget (ssname ss n))
nam (cdr (assoc 0 ent_l))
)
(if (= nam "LINE")
(setq ent_l (subst (append (reverse (cdr (reverse (assoc 10 ent_l))))
(list gaocheng)
)
(assoc 10 ent_l)
ent_l
)
ent_l (subst (append (reverse (cdr (reverse (assoc 11 ent_l))))
(list gaocheng)
)
(assoc 11 ent_l)
ent_l
)
)
(if (= nam "LWPOLYLINE")
(setq ent_l (subst (cons 38 gaocheng) (assoc 38 ent_l) ent_l))
(setq ent_l
(subst (append (reverse (cdr (reverse (assoc 10 ent_l))))
(list gaocheng)
)
(assoc 10 ent_l)
ent_l
)
)
)
)
(entmod ent_l)
(setq gaocheng (+ gaocheng gch)
n (1+ n)
)
)
(command "redraw")
(princ)
)

(defun c:tt (/ pt pt01 pt02 pt_lst ll ss L_ss ent_l nam e gaocheng gch) 
  (setq        pt     (getpoint "点取等高线垂线第1点:") 
        pt01   pt 
        pt02   pt 
        pt_lst nil 
  ) 
  (WHILE PT 
    (SETQ PT_LST (APPEND PT_LST (LIST PT)) 
          LL         (LENGTH pt_lst) 
          pt         (getpoint (strcat "\n点取等高线垂线第" 
                                   (rtos (+ 1 ll)) 
                                   "点(回车完成选择):" 
                           ) 
                           pt 
                 ) 
    ) 
    (if        pt 
      (progn (grdraw pt02 pt 1 1) (setq pt02 pt)) 
    ) 
  ) 
  (setq        ss    (ssget "f" pt_lst '((0 . "LINE,LWPOLYLINE,POLYLINE"))) 
        l_ss  (sslength ss) 
        ent_l (entget (ssname ss 0)) 
        nam   (cdr (assoc 0 ent_l)) 
  ) 
  (if (= nam "LWPOLYLINE") 
    (setq e           (cdr (assoc 38 ent_l)) 
          gaocheng (getreal 
                     (strcat "输入第一条等高线高程<" (rtos e 2 0) ">:") 
                   ) 
    ) 
    (setq e           (last (assoc 10 ent_l)) 
          gaocheng (getreal 
                     (strcat "输入第一条等高线高程<" (rtos e 2 0) ">:") 
                   ) 
    ) 
  ) 
  (if gaocheng 
    () 
    (setq gaocheng e) 
  ) 
  (setq gch (getreal "输入等高线间距<1000>:")) 
  (if gch 
    () 
    (setq gch 1000) 
  ) 
  (setq n 0) 
  (while (< n l_ss) 
    (setq ent_l        (entget (ssname ss n)) 
          nam        (cdr (assoc 0 ent_l)) 
    ) 
    (if        (= nam "LINE") 
      (setq ent_l (subst (append (reverse (cdr (reverse (assoc 10 ent_l)))) 
                                 (list gaocheng) 
                         ) 
                         (assoc 10 ent_l) 
                         ent_l 
                  ) 
            ent_l (subst (append (reverse (cdr (reverse (assoc 11 ent_l)))) 
                                 (list gaocheng) 
                         ) 
                         (assoc 11 ent_l) 
                         ent_l 
                  ) 
      ) 
      (if (= nam "LWPOLYLINE") 
        (setq ent_l (subst (cons 38 gaocheng) (assoc 38 ent_l) ent_l)) 
        (setq ent_l 
               (subst (append (reverse (cdr (reverse (assoc 10 ent_l)))) 
                              (list gaocheng) 
                      ) 
                      (assoc 10 ent_l) 
                      ent_l 
               ) 
        ) 
      ) 
    ) 
    (entmod ent_l) 
    (setq gaocheng (+ gaocheng gch) 
          n           (1+ n) 
    ) 
  ) 
  (command "redraw") 
  (princ) 
)

hisum · 发表于 2006-10-28 17:11:52

非常感谢！果然是高手啊

lff763 · 发表于 2014-11-26 11:34:37

怎样给样条曲线赋标高值

st788796 · 发表于 2014-11-26 14:37:08

lff763 发表于 2014-11-26 11:34
怎样给样条曲线赋标高值

首先你要检查spline是平面曲线，然后用move

alimax · 发表于 2016-12-20 16:57:44

果然是高手，确实可以。

如果能够划一条线，然后判断新划线与其他线的交点来自动赋值（省去手动点击每一条线的步骤）就更完美了

wu112031853 · 发表于 2017-8-17 09:08:20

谢谢！！！

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

[求助] [求助]：求批量给等高线赋高程的程序

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

相关帖子

浏览过的版块