GCD高程点z值修复[原创.附源码]

tryhi · 发表于 2011-8-17 16:49:08

本帖最后由 tryhi 于 2015-9-10 15:46 编辑

命令：gcxf（高程修复）
作用：由于某种原因，图上有些高程点的z坐标可能与标高不同，该程序将整张图中所有的z坐标与标高不同的高程点修复为正确的z坐标。（提示：该修复更改的是z坐标，而不是标高，正好与南方cass中检查修复相反）

续贴：-----------------------------------

更新至2.0，解决“错误: 参数类型错误: lselsetp nil”问题

寒潮大冬瓜 · 发表于 2024-5-16 00:31:20

;;;GCDD设置cass定义的属性块gcd中高程属性(标高或height值)为其插入点的z坐标
(DEFUN C:GCDD()(GCDD2024)(princ))
(defun GCDD2024(/ bt11 e h hh jd n s)
(princ "GCDD设置cass定义的属性块gcd中高程属性(标高或height值)为其插入点的z坐标QXQ")
(defun bt11 (e / s)
(if (and (setq e (vlax-ename->vla-object e))
(vla-Get-HasAttributes e)
)
(progn
(foreach x
(vlax-safearray->list (vlax-variant-value (vla-GetAttributes e)))
(if (OR (= "标高" (vla-Get-TagString x)) (= "height" (vla-Get-TagString x)))
   ;(if (= "标高" (vla-Get-TagString x))

(setq s (cons (vla-Get-TextString x)s))
)
)
(if s (car s))
)
)
)
(if (and (or (setq JD (getint "\n小数保留位数<4>: "))
   (setq jd 4)
   )
;(setq s (ssget '((0 . "insert") (2 . "GC*"))))
(setq s (ssget '((0 . "insert")(2 . "GC*"))))
(setq n (sslength s))
)
(while (and (setq e (ssname s (setq n (1- n))))
   (setq h (bt11 e))
   (setq h (read h))
   (numberp h)
   (setq h (atof (rtos h 2 jd)))
   (setq e (vlax-ename->vla-object e))
   (setq hh (vlax-get e 'InsertionPoint))
   )
(vlax-put e 'InsertionPoint (list (car hh)(cadr hh) h))
)
)
)

寒潮大冬瓜 · 发表于 2024-5-16 00:25:51

;GCD设置cass定义的属性块gcd200插入点Z坐标的值写到高程属性(height值)中去
(defun C:GCD (/ SS JD I EN0 EN1 ENT0 ENT1 PT0 STR)
  (if (SETQ SS (ssget '((0 . "insert") (2 . "*"))))
(progn
   (if (SETQ JD (getint "\n小数保留位数<4>: "))()(SETQ JD 4))
   (repeat (SETQ i (sslength SS))
(SETQ EN0  (ssname SS (SETQ i (1- i)))
ENT0 (entget EN0)
EN1  (entnext EN0)
ENT1 (entget EN1)
)
(SETQ PT0 (cdr (assoc 10 ENT0))) ;_插入点
(SETQ STR (rtos (caddr PT0) 2 JD)) ;_新内容
(entmod (subst (cons 1 STR) (assoc 1 ENT1) ENT1))
(entupd EN0) ;_更新
   )
   (princ)
)
  )
)

16699988885 · 发表于 2024-12-4 12:35:58

(defun c:UpdateElevation ()
  (setq ss (ssget '((0 . "INSERT") (2 . "GC200"))))
  (if ss
(progn
   (setq new_elevation (getreal "\n请输入新的高程值: "))
   (setq entities (ssname ss 0))
   (while (setq entity (entnext entities))
      (if (and (eq (cdr (assoc 0 (entget entity))) "ATTRIB")
               (equal (cdr (assoc 2 (entget entity))) "height"))
      (progn
         (setq attrib_data (entget entity))
         (setq new_attrib_data (subst (cons 1 (rtos new_elevation 2 3)) (assoc 1 attrib_data) attrib_data))
         (entmod new_attrib_data)
      )
      )
      (setq entities entity)
   )
   (princ "\n高程更新完成！")
)
(princ "\n没有找到指定的块参照。")
  )
  (princ)
)

(princ "\n加载完成。输入 UpdateElevation 来开始更新高程。")

ashuo · 发表于 2011-8-17 19:25:22

谢谢分享谢谢分享

lanlj0772 · 发表于 2011-8-17 19:45:06

谢谢楼主分享

我来注册 · 发表于 2011-11-5 15:33:05

谢谢楼主分享，弱弱的问一句：加载该lsp后应该输入什么命名名？我输入“gcxf”没作用。我是新手，请各位赐教。谢谢！

tryhi · 发表于 2011-11-15 20:48:36

我来注册发表于 2011-11-5 15:33
谢谢楼主分享，弱弱的问一句：加载该lsp后应该输入什么命名名？我输入“gcxf”没作用。我是新手，请各位赐教 ...

你是用南方CASS画的图吗？

chaozhong116 · 发表于 2011-11-17 22:18:48

不错，谢谢楼主的劳动成果！

ccshappy · 发表于 2012-3-1 10:00:06

非常的小程序对误操作的人来讲

╰☆珊瑚玉ヤ · 发表于 2013-4-14 22:40:15

小弟对于编程不懂
我下载了后，加载成功
但是，输入命令统一失败
命令: gcxf ; 错误: 参数类型错误: lselsetp nil
不懂，这是什么原因呢？该如何解决呢？其他人下载都能正常使用吗？！

changyiran · 发表于 2013-4-14 23:11:58

╰☆珊瑚玉ヤ发表于 2013-4-14 22:40 小弟对于编程不懂我下载了后，加载成功但是，输入命令统一失败

需要的话我可以发给你源程序，图元对象和vla对象两种做法！

╰☆珊瑚玉ヤ · 发表于 2013-4-17 17:49:45

changyiran 发表于 2013-4-14 23:11
需要的话我可以发给你源程序，图元对象和vla对象两种做法！

谢谢大哥。期待您的分享
我的邮箱zhuofeng41@126.com

账号		自动登录	找回密码
密码			注册

[函数] GCD高程点z值修复[原创.附源码]

本帖子中包含更多资源

点评