[LISP程序]：针对cass7.0展高程点批量修改程序

ljttjl

源码在: 测绘信息网论坛 → 测绘软件专题 → AutoCAD二次开发 位置,欢迎关注!

malongwen

非常感谢，能上传到本网站更好。

ljttjl

因我在那里发的程序较多，有些不便。这是测绘信息网论坛网址：http://www.othermap.com/dvbbs/    可以查看。

zml84

楼主推荐的页面，广告太烦人，不注册还不能看源码。

ljttjl

从那个论坛原文粘贴过来了

有时在绘制地形图时，展的高程点值需要批量修改，用下面程序进行修正 (根据使用者提出：易将修改高程值和修改高程值精度分别定义成各自的命令，且在命令提示行输入的建议，又对程序做了第二次修改)：
1、下载后将xggcd.lsp、xggcdjd.lsp文件放在autocad支持搜索路径下
2、打开要修改的图形，然后在命令行键入 (load "xggcd.lsp")  回车  和 (load "xggcdjd.lsp")   回车
3、加载成功后，a、在命令行键入  xggcd  回车后按提示操作即可修改高程值;b、在命令行键入  xggcdjd  回车后按提示操作即可修改高程值精度。
欢迎下载，如有问题联系李先生，至邮箱：ljttjl@tom.com

jx2008

源程序代码公布一下啊

zml84

[php]
;;;功能：设置cass定义的属性块gcd中高程属性为其插入点的z坐标
(defun C:SETGCD        (/ SS JD I EN0 EN1 ENT0 ENT1 PT0 STR)
    (if        (setq SS (ssget '((0 . "insert") (2 . "gc200"))))
        (progn
            (if        (setq JD (getint "\n小数保留位数<2>: "))
                ()
                (setq JD 2)
            )
            ;;
            (setq I 0)
            (repeat (sslength SS)
                (setq EN0  (ssname SS I)
                      ENT0 (entget EN0)
                      EN1  (entnext EN0)
                      ENT1 (entget EN1)
                )
                (setq PT0 (cdr (assoc 10 ENT0))) ;_插入点
                (setq STR (rtos (caddr PT0) 2 JD)) ;_新内容
                (setq ENT1 (subst (cons 1 STR) (assoc 1 ENT1) ENT1))
                (entmod ENT1)
                (entmod ENT0) ;_更新
                (setq I (1+ I))
            )
        )
    )
    (princ)
)
;;;======================================================
;;;功能：设置cass定义的属性块gcd中高程属性加上一个数值
(defun C:EDITGCD (/ SS REAL JD I EN0 EN1 ENT0 ENT1 TMP STR)
    (if        (and (setq SS (ssget '((0 . "insert") (2 . "gc200"))))
             (setq REAL (getreal "\n请输入高程增加值: "))
        )
        (progn
            (if        (setq JD (getint "\n小数保留位数<2>: "))
                ()
                (setq JD 2)
            )
            ;;
            (setq I 0)
            (repeat (sslength SS)
                (setq EN0  (ssname SS I)
                      ENT0 (entget EN0)
                      EN1  (entnext EN0)
                      ENT1 (entget EN1)
                )
                (setq TMP (read (cdr (assoc 1 ENT1)))) ;_当前值
                (setq STR (rtos (+ TMP REAL) 2 JD)) ;_新内容
                (setq ENT1 (subst (cons 1 STR) (assoc 1 ENT1) ENT1))
                (entmod ENT1)
                (entmod ENT0) ;_更新
                (setq I (1+ I))
            )
        )
    )
    (princ)
)
;;;======================================================
[/php]

netbee

其实CASS的编程技术有些是很弱智的，看看公路设计软件（纬地之类），那才叫编程。可CAD上出色的测绘软件本不没有多少，只能这样了。

ljttjl

感谢关注

wangxj2002

收下试试看！谢谢啦！！

cwy5560

wqewqewqewqe

cwy5560

Z值没改动！