文件名：CDGXZC.lsp
执行命令：CDGXZC
功能：等高线层、值相符相符检查
;       =============================================
;       |           等高线层、值相符相符检查        |
;       |         版本: V1.1   作者: 金德海         |
;       |             E_mail jdhszh@163.com         |
;       =============================================
(defun C:CDGXZC()
(setvar "cmdecho" 0)
(if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com))
(setq dgj(getreal "\n 输入等高距: "))
(setq sqx(getstring "\n 输入等高线首曲线层:"))
(setq sqxk(getreal "\n 输入首曲线宽度:"))
(setq jqx(getstring "\n 输入等高线计曲线层:"))
(setq jqxk(getreal "\n 输入计曲线宽度:"))
(setq ss (xzj sqx jqx))
(setq n (sslength ss) i 0 x 0)
 (repeat n
 (setq stm (ssname ss i))
(setq object(vlax-ename->vla-object stm))
(setq gcz (vla-get-Elevation object))
(setq l_with(vla-get-ConstantWidth object))
 (if (= gcz 0) (vla-put-Color object 2))
 (setq tc(vla-get-Layer Object))
(if (= dgj 2.5)
 (progn
 (setq km(rem gcz dgj))                 ;; 为零对
 (setq ys(rem (/ gcz dgj) 4.0))         ;; 为零计曲线
 )
 (PROGN
 (setq km(rem gcz dgj ))
 (setq ys(rem (/ gcz dgj) 5.0))
 )
)
(if (/= km 0)
(progn
 (vla-put-Color object 2)
 (setq x 1)
 )
)
(if (and (= ys 0) (= tc sqx))
(progn
 (vla-put-Color object 2)
 (setq x 1)
 )
)
(if (and (/= ys 0) (= tc jqx))
(progn
 (vla-put-Color object 2)
 (setq x 1)
 )
)
 (setq i(+ 1 i))
 )
(vlax-release-object object)
(if (= x 0) (alert "等高线层、值都相符"))
(setq kk (ssget "x" (list '(-4 . "<AND")
                         '(-4 . "<OR")
                          (cons 8 sqx)
                          (cons 8 jqx)
                          '(-4 . "OR>")
                          (cons 62 2)
                          '(-4 . "AND>")
)))
(if kk
 (alert (strcat "图内共有" (itoa(sslength kk)) "根曲线层、值不符，注意查改!" ))
 )
(setq stm nil dgj nil km nil ys nil kk nil xx nil xxx nil)
(setvar "cmdecho" 1)
)
(defun xzj(lay1 lay2)
(ssget "x" (list
                   '(-4 . "<AND")
                   '(-4 . "<OR")
                    (cons 0 "lwpolyline")
                    (cons 0 "polyline")
                   '(-4 . "OR>")
                   '(-4 . "<OR")
                    (cons 8 lay1)
                    (cons 8 lay2)
                   '(-4 . "OR>")
                '(-4 . "AND>")
               ))
)

文件名：dgxfgc.lsp
执行命令：DGXF
功能：根据第一根等高线赋高程
;       =============================================
;       |          根据第一根等高线赋高程           |
;       |         版本: V1.1   作者: 金德海         |
;       |             E_mail jdhszh@163.com         |
;       =============================================
(defun C:DGXF( / w s z g1 g2 tp1 tp2 ss1)
(setvar "cmdecho" 0)
(if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com))
(command "undo" "be")
(setq w(getvar "userr1"))
(if (= w 0)
 (progn
 (setq w(getreal "\n输入等高距: "))
 (setvar "userr1" w)
 (setq w(getvar "userr1"))
 )
)
  (initget "g d")
  (setq qc_flags (getkword "\nG<往高处>/D<往低处>:<G>"))
  (if (eq qc_flags nil)
      (setq qc_flags "g")
      )
  (if (eq qc_flags "g")
      (princ)
      )
  (if (eq qc_flags "d")
      (setq w(- 0 w))
      )
     (setq th(entsel "\n选有值线:"))
     (if th (gele (car th)) (setq elev(getreal "\n没选到!请输入基线高程值: ")))
     (setq tp1 (getpoint "\n指定第一点:"))
     (setq tp2 (getpoint "\n指定第二点:"))
     (setq plist (list tp1 tp2))
(setq S (ssget "F" plist ))
(if s
 (progn
 (setq a 0)
 (repeat (sslength s)
 (setq z (setq ss1(ssname s a)))
 (setq g1(+ elev (* w a) w))
 (pele z g1)
;(setq g2(cons 38 g1))
;(entmod (subst g2 (assoc '38 z) z))
(if (= (abs w) 2.5) (setq g3(rem (/ g1 w) 4)))
(if (/= (abs w) 2.5) (setq g3(rem (/ g1 w) 5)))
 (if (= g3 0) (pcolor 1))
 (if (or (= g3 1) (= g3 -1))(pcolor 2))
 (if (or (= g3 2) (= g3 -2))(pcolor 3))
 (if (or (= g3 3) (= g3 -3))(pcolor 4))
 (if (or (= g3 4) (= g3 -4))(pcolor 5))
 (setq a (1+ a ))
 )
(princ "\n ")
(princ "最后一线值" )
(princ g1)
(princ)
(command "undo" "e")
)(princ "\n sorry 你没选到等高线!"))
(setvar "cmdecho" 1)
)
;;
(defun gele(name-lsp)
(setq vlaobject-name (vlax-ename->vla-object name-lsp))
(setq elev (vla-get-Elevation vlaobject-name));;高程
(vlax-release-object vlaobject-name)
)
(defun pele(name-lsp elev)
(setq vlaobject-name (vlax-ename->vla-object name-lsp))
(vla-put-Elevation vlaobject-name elev) ;;写入高程
)
(defun pcolor(n)
(vla-put-Color vlaobject-name n)
(vlax-release-object vlaobject-name)
)

文件名：GCFS.lsp
执行命令：GCFS
功能：高程分色
;       =============================================
;       |              高程分色                     |
;       |         版本: V1.1   作者: 金德海         |
;       |             E_mail jdhszh@163.com         |
;       =============================================
(defun C:GCFS(/ LAY ss name a)
(if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com))
 (setq lay(getstring "\n输入等高线所在层<支持统配符*>:"))
 (IF dg_j (princ) (setq dg_j(getreal "\n输入等高距: ")))
(setq ss(ssget "x" (list (cons 8 lay)(cons 0 "LWPOLYLINE"))))
 (setq a 0)
 (repeat (sslength ss)
 (setq name(ssname ss a))
 (gelve name)
 (if (= (abs dg_j) 2.5) (setq g3(rem (/ elev dg_j) 4)))
 (if (/= (abs dg_j) 2.5) (setq g3(rem (/ elev dg_j) 5)))
 (if (= g3 0) (pcolor 1))
 (if (or (= g3 1) (= g3 -1))(pcolor 2))
 (if (or (= g3 2) (= g3 -2))(pcolor 3))
 (if (or (= g3 3) (= g3 -3))(pcolor 4))
 (if (or (= g3 4) (= g3 -4))(pcolor 5))
 (if (and (/= g3 1) (/= g3 2) (/= g3 3) (/= g3 0) (/= g3 4)) (pcolor 8))
 (setq a (1+ a ))
 )
)
(defun gelve(name-lsp)
(setq vlaobject-name (vlax-ename->vla-object name-lsp))
(setq elev (vla-get-Elevation vlaobject-name));;高程
)
;;
(defun pcolor(n)
(vla-put-Color vlaobject-name n)
(vlax-release-object vlaobject-name)
)