【万能高程】基本能解决大部分cass7.1高程方面的问题

652758365

;    万能高程.lsp    zzh作品
;    1.gc1     加密近似高程       正参数=gc1-cs-zhen    负参数gc1-cs-fu
(defun c:gc1 (/ work h dw gc1-cs-zhen gc1-cs-fu dw-ty xy xyz1 xyz2)
     (setvar "osmode" 0)
     (princ "\n 欢迎使用【管线管家->cass助手->万能高程->gc1加密近似高程")
   (setq gc1-cs-zhen (getreal "\n 请输入高程加减上限   "))
   (setq gc1-cs-fu (getreal "\n 请输入高程加减下限   "))
  
  (if (and gc1-cs-zhen gc1-cs-fu)
    (progn
     (setq dw (entsel "\n 请选取基本地物【高程点/TEXT/MTEXT/LWPOLYLINE线/POLYLINE线/各类块/】"))
  (if dw
    (progn
      (setq dw-ty (entget (car dw)))
      (if  (or (= (cdr (assoc 0 dw-ty)) "INSERT")
               (= (cdr (assoc 0 dw-ty)) "TEXT")
               (= (cdr (assoc 0 dw-ty)) "MTEXT")
               (= (cdr (assoc 0 dw-ty)) "POLYLINE")     )
               (setq dw-z (nth 3 (assoc 10 dw-ty)))      )
      (if (= (cdr (assoc 0 dw-ty)) "LWPOLYLINE") (setq dw-z (cdr (assoc 38 dw-ty)))      )
      (if (and gc1-cs-zhen gc1-cs-fu dw-z)
  (progn
    (while (< 1 2)
      (gxgj-sjs gc1-cs-fu gc1-cs-zhen)   ;    负参数  至  正参数之间的随机数
      (command "-layer" "m" "万能高程" "c" "7" "" "")
      (setq xy (getpoint "\n点位[按ESC键退出.]"))
      (setq xyz1 (list (car xy) (cadr xy) (+ dw-z sjs)    )    )
      (setq xyz2 (list (car xy) (- (cadr xy) 1.75) (+ dw-z sjs)    )    )
      (command "-insert" "万能高程点" xyz1 "3.5" "3.5" "0")
      (command "text" xyz2 "1.21" "0" (rtos (+ dw-z sjs) 2 2))
      (command "-layer" "m" "0" "")     )         ))         )
    (progn
    (princ "\n没有选中地物!")     )      )       ))
  (setq work nil)
    (princ)
)
;      随机数子函数      sjs=随机数
(defun gxgj-sjs (gc1-cs-fu gc1-cs-zhen)
       (vl-load-com)
       (vla-eval (vlax-get-acad-object)
              "Randomize : ThisDrawing.setVariable \"USERR5\" ,CDbl((Rnd))")
       (setq sjs (+ gc1-cs-fu (* (getvar "userr5") (- gc1-cs-zhen gc1-cs-fu))))
       (if (= 'int (type gc1-cs-fu) (type gc1-cs-zhen)) (fix sjs) sjs)
)
;    2.gc2   高程批量提取
(defun c:gc2 (/ tq-dx j-tq wj-tq k-tq sm-tq dx-tq ty-tq)
      (princ "\n 欢迎使用【管线管家->cass助手->万能高程->gc2高程批量提取")
      (setq tq-dx (getint "\n 请选取对象【1.万能高程 2.GCD(块) 3.GCD(注记) 4._aid(块) 5._aid(注记) 6.zdh(点) 7.zdh(注记) 8.GCD(块属性值)】  "))
  (if (or (= tq-dx 1) (= tq-dx 2) (= tq-dx 3) (= tq-dx 4) (= tq-dx 5) (= tq-dx 6) (= tq-dx 7) (= tq-dx 8)  )
    (progn
    (if (= tq-dx 1) (setq j-tq (ssget "x" '((-4 . "<and") (0 . "INSERT") (8 . "万能高程") (-4 . "and>"))))    )
    (if (or (= tq-dx 2) (= tq-dx 8)) (setq j-tq (ssget "x" '((-4 . "<and") (0 . "INSERT") (8 . "GCD") (-4 . "and>"))))    )
    (if (= tq-dx 3) (setq j-tq (ssget "x" '((-4 . "<and") (0 . "TEXT") (8 . "GCD") (-4 . "and>"))))    )
    (if (= tq-dx 4) (setq j-tq (ssget "x" '((-4 . "<and") (0 . "INSERT") (8 . "_aid") (-4 . "and>"))))    )
    (if (= tq-dx 5) (setq j-tq (ssget "x" '((-4 . "<and") (0 . "TEXT") (8 . "_aid") (-4 . "and>"))))    )
    (if (= tq-dx 6) (setq j-tq (ssget "x" '((-4 . "<and") (0 . "POINT") (8 . "zdh") (-4 . "and>"))))    )
    (if (= tq-dx 7) (setq j-tq (ssget "x" '((-4 . "<and") (0 . "TEXT") (8 . "zdh") (-4 . "and>"))))    )
     
   
;  其他对象    (setq j-tq (ssget "x" (list (cons -4 "<and") (cons 0 ty-0) (cons 8 ty-8) (cons -4 "and>"))))
   
       (setq wj-tq (open "C:/万能高程.dat" "w"))    ;    以后扩展为追加模式
       (setq k-tq 0 sm-tq (sslength j-tq))
     (while (< k-tq sm-tq)
       (setq dx-tq (ssname j-tq k-tq))
       (setq ty-tq (entget dx-tq))
       (if (= tq-dx 8)
         (progn
       (princ (strcat (rtos (+ k-tq 1) 2 0) ",," (rtos (nth 1 (assoc 10 ty-tq)) 2 3)
                      "," (rtos (nth 2 (assoc 10 ty-tq)) 2 3) "," (rtos (atof (cdr (assoc 1 (entget (entnext dx-tq))))) 2 2) "\n") wj-tq)      )
         (progn
       (if (= (cdr (assoc 0 ty-tq)) "TEXT")
         (princ (strcat (rtos (+ k-tq 1) 2 0) ",," (rtos (nth 1 (assoc 10 ty-tq)) 2 3)
                      "," (rtos (nth 2 (assoc 10 ty-tq)) 2 3) "," (rtos (atof (cdr (assoc 1 ty-tq))) 2 3) "\n") wj-tq)      )
       (if (or (= (cdr (assoc 0 ty-tq)) "INSERT") (= (cdr (assoc 0 ty-tq)) "POINT")       )
       (princ (strcat (rtos (+ k-tq 1) 2 0) ",," (rtos (nth 1 (assoc 10 ty-tq)) 2 3)
                      "," (rtos (nth 2 (assoc 10 ty-tq)) 2 3) "," (rtos (nth 3 (assoc 10 ty-tq)) 2 3) "\n") wj-tq)      )       )        )


      
       (setq k-tq (+ k-tq 1))       )
       (close wj-tq)      ))
  (setq wj-tq nil j-tq nil)
       (princ (strcat "\n一共成功提取 " (rtos sm-tq 2 0) " 个符合条件的高程点."))
       (princ "\n C:/万能高程.dat")
       (princ)
)
;    3.gc3  批量 + - 高程点的高程值
(defun c:gc3 (/ z-g3 j-g3 k-g3 k3 sm-g3 dx-g3 ty-g3 xyz21 xyz22)
     (setvar "osmode" 0)
     (princ "\n 欢迎使用【管线管家->cass助手->万能高程->gc3批量 + - 高程点的高程值")
     (setq z-g3 (getreal "\n 请输入加减改正值<正为加,负为减> "))
     (if z-g3
       (progn
  (setq j-g3 (ssget))
  (if j-g3
    (progn
  (setq k-g3 0 k3 0 sm-g3 (sslength j-g3))
       (while (< k-g3 sm-g3)
         (setq dx-g3 (ssname j-g3 k-g3))
         (setq ty-g3 (entget dx-g3))
         (if (and (= (cdr (assoc 0 ty-g3)) "INSERT") (= (cdr (assoc 8 ty-g3)) "GCD")   )
             (progn
              (setq xyz21 (list (nth 1 (assoc 10 ty-g3)) (nth 2 (assoc 10 ty-g3)) (+ (nth 3 (assoc 10 ty-g3)) z-g3)))
              (setq xyz22 (list (nth 1 (assoc 10 ty-g3)) (- (nth 2 (assoc 10 ty-g3)) 1.75) (+ (nth 3 (assoc 10 ty-g3)) z-g3)))
              (command "-layer" "m" "万能高程" "c" "7" "" "")
              (command "-insert" "万能高程点" xyz21 "3.5" "3.5" "0")
              (setq k3 (+ k3 1))
              (command "text" xyz22 "1.21" "0" (rtos (+ (nth 3 (assoc 10 ty-g3)) z-g3) 2 2))
              (command "erase" dx-g3 "")
              (command "-layer" "m" "0" "")      ))
         (setq k-g3 (+ k-g3 1))     )           ))          ))
  (setq j-g3 nil)
  (princ (strcat "\n 一共批量处理 " (rtos k3 2 0) " 个GCD."))
  (princ)
)
;      批量 + - 等高线的高程值
(defun c:gc4 (/ dgj zzzzz j-g4 k-g4 sm-g4 dx-g4 z-g4)
     (setvar "osmode" 0)
     (princ "\n 欢迎使用【管线管家->cass助手->万能高程->gc3批量 + - 等高线的高程值")
     (setq dgj (getint "\n 请选取等高距 【  1. 0.5米等高距   2. 1米等高距   3. 2米等高距 】  "))
  (if dgj
    (progn
       (setq zzzzz (getreal "\n 请输入加减改正值<正为加,负为减> "))
      (if zzzzz
        (progn
       (setq j-g4 (ssget))
       (if j-g4
         (progn
       (setq k-g4 0 sm-g4 (sslength j-g4))
       (while (< k-g4 sm-g4)
         (setq dx-g4 (ssname j-g4 k-g4))
;   删除等高线注记
         (if (and (= (cdr (assoc 0 (entget dx-g4))) "TEXT") (= (cdr (assoc 8 (entget dx-g4))) "DGX"))
              (command "erase" dx "")     )
         (if (= (cdr (assoc 8 (entget dx-g4))) "DGX")
           (progn
          (if (= (cdr (assoc 0 (entget dx-g4))) "POLYLINE")  (setq z-g4 (+ (nth 3 (assoc 10  (entget dx-g4))) zzzzz))     )
          (if (= (cdr (assoc 0 (entget dx-g4))) "LWPOLYLINE")   (setq z-g4 (+ (cdr (assoc 38  (entget dx-g4))) zzzzz))    )
;    修改标高
          (command "change" dx-g4 "" "p" "E" z-g4 "")
          (command "change" dx-g4 "" "p" "c" "2" "")       ;    全部改成  黄色
;    修改颜色
          (if (= dgj 1)
            (if (or (= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "0.0") (= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "2.5")
                    (= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "5.0") (= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "7.5")      )
            (command "change" dx-g4 "" "p" "c" "3" "")       )        )
          (if (= dgj 2)
            (progn
            (if (or (= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "0.0") (= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "5.0") )
            (command "change" dx-g4 "" "p" "c" "3" "")       )
            (if (= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 1) 2) ".5")
            (command "erase" dx-g4 "")       )       ))
          (if (= dgj 3)
            (progn
            (if (= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "0.0")
            (command "change" dx-g4 "" "p" "c" "3" "")       )
            (if (and (/= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "0.0")
                     (/= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "2.0")
                     (/= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "4.0")
                     (/= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "6.0")
                     (/= (substr (rtos z-g4 2 1) (- (strlen (rtos z-g4 2 1)) 2) 3) "8.0")         )
            (command "erase" dx-g4 "")       )       ))     ))
         (setq k-g4 (+ k-g4 1))      )           ))      ))      ))
  (setq dgj nil zzzzz nil j-g4 nil)
         (princ "\n 选择范围内的{等高线注记要重新注记}(本工具暂时未添加自动加高程注记功能)")
         (princ)
)
;      批量 + - 【ZDH】【_aid】 的高程值
(defun c:gc5 (/ j-g5 z5 k-g5 sm-g5 dx-g5 ty-g5 xy-old xy-new)
        (setvar "osmode" 0)
        (princ "\n 批量 + - 【zdh】【_aid】 的高程值")
        (princ "\n 选取高程点<框选>")
        (setvar "osmode" 0)
      (setq j-g5 (ssget))
      (setq z5 (getreal "\n 请输入加减改正值<正为加,负为减> "))
   (setq k-g5 0 sm-g5 (sslength j-g5))
   (while (< k-g5 sm-g5)
       (setq dx-g5 (ssname j-g5 k-g5))
       (setq ty-g5 (entget dx-g5))
     (if (or (= (cdr (assoc 8 ty-g5)) "zdh") (= (cdr (assoc 8 ty-g5)) "_aid") (= (cdr (assoc 8 ty-g5)) "ZDH")   )
       (progn
       (setq xy-old (list (nth 1 (assoc 10 ty-g5)) (nth 2 (assoc 10 ty-g5)) (nth 3 (assoc 10 ty-g5))))
       (setq xy-new (list (nth 1 (assoc 10 ty-g5)) (nth 2 (assoc 10 ty-g5)) (+ (nth 3 (assoc 10 ty-g5)) z5)))
         (command "move" dx-g5 "" xy-old xy-new)       ))
         (setq k-g5 (+ k-g5 1))    )
     (setq j-g5 nil z5 nil)
     (princ)
)
;        高程点     Z值   与  属性值   检查
(defun c:gc6 (/ j-g6 k-g6 kk-g6 sm-g6 dx-g6 xy-g6)
          (princ "\n 欢迎使用【管线管家->cass助手->万能高程->gc6 Z值与属性值检查")
          (setq j-g6 (ssget "x" '((-4 . "<and") (0 . "INSERT") (8 . "GCD") (-4 . "and>"))))
          (if j-g6
             (progn
           (setq k-g6 0 kk-g6 0 sm-g6 (sslength j-g6))
     (while (< k-g6 sm-g6)
       (setq dx-g6 (ssname j-g6 k-g6))
       (setq xy-g6 (list (nth 1 (assoc 10 (entget dx-g6))) (nth 2 (assoc 10 (entget dx-g6)))   ))
       (if (assoc 1 (entget (entnext dx-g6)))
       (if (/= (rtos (nth 3 (assoc 10 (entget dx-g6))) 2 2) (rtos (atof (cdr (assoc 1 (entget (entnext dx-g6))))) 2 2))
         (progn
           (setq kk-g6 (+ kk-g6 1))
           (command "CIRCLE" xy-g6 "2.88" "")     ))    )
       (setq k-g6 (+ k-g6 1))    )     ))
    (setq j-g6 nil)
    (princ (strcat "\n一共发现 " (rtos kk-g6 2 0) " 个高程点 Z值与属性值矛盾."))
    (princ)
)
;     删除控制点下面的高程点
(defun c:gc7 ()
          (princ "\n 欢迎使用【管线管家->cass助手->万能高程->gc7删除控制点下面的高程点")
          (setq j-g7 (ssget "x" '((-4 . "<and") (0 . "INSERT") (8 . "KZD") (-4 . "and>"))))
          (if j-g7
    (progn
           (setq k-g7 0 sm-g7 (sslength j-g7))
     (while (< k-g7 sm-g7)
       (setq dx-g7 (ssname j-g7 k-g7))
       (setq x-g7 (nth 1 (assoc 10 (entget dx-g7))) y-g7 (nth 2 (assoc 10 (entget dx-g7)))   )
           (setq chanshu-g7 0.1)        ;   搜索参数= 1.5m
           (setq max-jl-g7 2.0)
      (while (< chanshu-g7 max-jl-g7)
                  (setq xy-1-g7 (list (+ x-g7 chanshu-g7) (+ y-g7 chanshu-g7))  xy-2-g7 (list (- x-g7 chanshu-g7) (- y-g7 chanshu-g7))   )
        (setq j-line-g7 (ssget "_C" xy-1-g7 xy-2-g7 '((-4 . "<and") (8 . "GCD") (-4 . "and>"))))
        (if j-line-g7
          (progn
           (setq k-line-g7 0 sm-line-g7 (sslength j-line-g7))
    (while (< k-line-g7 sm-line-g7)
        (setq dx2-g7 (ssname j-line-g7 k-line-g7))
        (command "erase" dx2-g7 "")
        (setq k-line-g7 (+ k-line-g7 1))   )         ))
        (setq chanshu-g7 (+ chanshu-g7 1))      )
        (setq j-line-g7 nil)
        (setq k-g7 (+ k-g7 1))    )              ))
  (setq j-g7 nil)
    (princ)
)

652758365

461045462 发表于 2012-7-3 10:41
谢谢楼主的分享！
运行gc6显示：
命令: gc6

(defun c:gc6 (/ j-g6 k-g6 kk-g6 sm-g6 dx-g6 xy-g6)
          (princ "\n 欢迎使用【管线管家->cass助手->万能高程->gc6 Z值与属性值检查")
          (setq j-g6 (ssget "x" '((-4 . "<and") (0 . "INSERT") (8 . "GCD") (-4 . "and>"))))
          (if j-g6

应该是图上没有高程点或不在GCD图层，也可能不满足选择集条件，
这是源码，修改一下就可以了....

fanqinwei

这是源码，感谢ZZ，同时希望能写个说明。感觉程序还有可扩展的空间，请继续。

461045462

652758365 发表于 2012-7-4 15:05
(defun c:gc6 (/ j-g6 k-g6 kk-g6 sm-g6 dx-g6 xy-g6)
          (princ "\n 欢迎使用【管线管家->cass助 ...

谢谢652758365
感谢提供源码，可以适当修改了。
谢谢！

004

652758365 发表于 2012-7-4 15:03
;    万能高程.lsp    zzh作品
;    1.gc1     加密近似高程       正参数=gc1-cs-zhen    负参数gc1-cs-f ...

好码，踩个脚印。

tracy张悦

谢谢楼主！分享这么好的东东！！！

umy131

好东西谢谢分享

daoshi2902

好东西，谢谢分享对测绘作业者大有裨益

xiabin68

好东西啊，，，，，

skyahaii

bucuo
,xuexile