等高线处理,希望对测绘同行们有用阿

				;;;本程序实现批量修改高程值,仅针对cass7.0展高程点修改
				;;;需将同名的xggcd.dcl文件一起放入d:盘根目录
				;;;该程序对话框部分很好的实现了：通过弹出对话框中输入数值，返回数值
				(defun c:xggcd ( )
				
				  (defun gettile ()
				    (setq  b (get_tile "text1"))
				  )
				  (setq a (load_dialog "d:/xggcd.dcl"))
				  
				  (setq x 1)
				  (setq b "0")
				  (setq d "")
				  (while (= x 1)
				    (if (not (new_dialog "xggcd" a)) (exit))
				
				    (set_tile "text1" b)
				    (set_tile "error" d)
				    (action_tile "accept" "(gettile)(done_dialog 1)")
				    (action_tile "cancel" "(progn (setq b \"0\")(done_dialog 0))")
				    (setq c (start_dialog))
				
				    (if (or (= (type (read b)) 'int) (= (type (read b)) 'real))
				      (setq x 0)
				      (setq x 1 d "请输入数值！")
				    )
				  )
				  (if (= c 1)
				    (progn
				      (setq b1 (atof b))
				      (setq b2 (rtos b1 2 2))
				      (setq b3 (atof b2))
				
				      (vl-load-com)
				      (setq s (ssget "x" '((0 . "INSERT")(8 . "GCD"))))
				      (setq s1 (sslength s))
				      (setq i 0)
				      (while (< i s1)
					(setq s2 (ssname s i))
					(setq s3 (entget s2))
					(setq s4 (assoc 10 s3))
					(setq s5 (cdr s4))
					(setq s6 (list 10 (car s5) (cadr s5) (+ (caddr s5) b1)))
					(entmod (subst s6 s4 s3))
				
					(setq t1 (vlax-ename->vla-object s2))
					(setq t2 (vla-GetAttributes t1))
					(setq t3 (vlax-variant-value t2))
					(setq t4 (vlax-safearray->list t3))
					(setq t5 (car t4))
					(setq t6 (atof (vla-get-textstring t5)))
					(setq t7 (rtos (+ t6 b3) 2 2))	
					(vla-put-textstring t5 t7)
				
				
					(setq t8 (vlax-vla-object->ename t5))
					(setq t9 (entget t8))
					(setq t10 (assoc 10 t9))
					(setq t11 (cdr t10))
					(setq t12 (list 10 (car t11) (cadr t11) (+ (caddr t11) b1)))
					(entmod (subst t12 t10 t9))
					(vla-update t5)
					
				        (setq i (1+ i))
				      )
				      
				      (princ "\n已修改完成")
				    )
				    (princ "\n已取消修改")
				  )
				  
				  (unload_dialog a)
				  (princ)
				)