xggcd.lsp

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

;;;本程序实现批量修改高程值,仅针对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)
)