明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 9446|回复: 29

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

    [复制链接]
发表于 2011-8-17 16:49:08 | 显示全部楼层 |阅读模式
本帖最后由 tryhi 于 2015-9-10 15:46 编辑

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






续贴:-----------------------------------


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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 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)
    )
  )
)
发表于 2017-9-17 15:22:43 | 显示全部楼层
虽然看不懂 但是觉得很厉害
发表于 2011-8-17 19:25:22 | 显示全部楼层
谢谢分享谢谢分享
发表于 2011-8-17 19:45:06 | 显示全部楼层
谢谢楼主分享
发表于 2011-11-5 15:33:05 | 显示全部楼层
谢谢楼主分享,弱弱的问一句:加载该lsp后应该输入什么命名名?我输入“gcxf”没作用。我是新手,请各位赐教。谢谢!
 楼主| 发表于 2011-11-15 20:48:36 | 显示全部楼层
我来注册 发表于 2011-11-5 15:33
谢谢楼主分享,弱弱的问一句:加载该lsp后应该输入什么命名名?我输入“gcxf”没作用。我是新手,请各位赐教 ...

你是用南方CASS画的图吗?
发表于 2011-11-17 22:18:48 | 显示全部楼层
不错,谢谢楼主的劳动成果!
发表于 2012-3-1 10:00:06 | 显示全部楼层
非常的小程序 对误操作的人来讲
发表于 2013-4-14 22:40:15 | 显示全部楼层
小弟对于编程不懂
我下载了后,加载成功
但是,输入命令统一失败
命令: gcxf ; 错误: 参数类型错误: lselsetp nil
不懂,这是什么原因呢?该如何解决呢?其他人下载都能正常使用吗?!

点评

我测试可以啊,测试环境CASS2008 FOR CAD2004  发表于 2013-8-3 22:49
发表于 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
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-25 17:21 , Processed in 0.190735 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表