提示点取的点是用老栏选等高线的!
第一条等高线是离第一点最近的!它是"基准"!
等高线间距可以输入负值,等高线就成下降的了!
程序在2006下好像没什么问题,但我在2000下确遇到了麻烦,正在寻找解决办法!
遇到的问题奇怪的很,选择集内实体的排序顺序混乱;同样的图,在r14下,ctrl+c然后ctrl+v再炸开后,用程序调整等高线,以前排序混乱的情况却没了!不知道问题到底出在哪儿?!

- (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)
- )
|