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

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

本帖最后由 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)
    )
)
)

pusslica 发表于 2017-9-17 15:22:43

虽然看不懂 但是觉得很厉害

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 static/image/common/back.gif
谢谢楼主分享，弱弱的问一句：加载该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 static/image/common/back.gif
需要的话我可以发给你源程序，图元对象和vla对象两种做法！

谢谢大哥。期待您的分享
我的邮箱zhuofeng41@126.com
页: [1] 2 3
查看完整版本: GCD高程点z值修复[原创.附源码]