; 万能高程.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)
)
461045462 发表于 2012-7-3 10:41 static/image/common/back.gif
谢谢楼主的分享！
运行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 于 2012-7-4 19:15 编辑
这是源码，感谢ZZ，同时希望能写个说明。感觉程序还有可扩展的空间，请继续。
652758365 发表于 2012-7-4 15:05 static/image/common/back.gif
(defun c:gc6 (/ j-g6 k-g6 kk-g6 sm-g6 dx-g6 xy-g6)
(princ "\n 欢迎使用【管线管家->cass助 ...
谢谢652758365
感谢提供源码，可以适当修改了。
谢谢！
652758365 发表于 2012-7-4 15:03 static/image/common/back.gif
; 万能高程.lsp zzh作品
; 1.gc1 加密近似高程 正参数=gc1-cs-zhen 负参数gc1-cs-f ...
好码，踩个脚印。
谢谢楼主！分享这么好的东东！！！
好东西谢谢分享
好东西，谢谢分享对测绘作业者大有裨益
好东西啊，，，，，
bucuo
,xuexile