纳兰龙珠 发表于 2013-10-26 11:34:28

fanqinwei 发表于 2012-12-22 09:59 static/image/common/back.gif
这个CASS本身自带，不必再去编写

求教，怎么调用，谢谢

蓝图测绘 发表于 2013-11-30 22:48:43

本帖最后由 蓝图测绘 于 2013-11-30 22:51 编辑

我也来一个，在"Gu_xl” 版主的基础上，加了一个用范围线选择高程点生成数据文件。

;有选择性的拾取高程点生成DAT文件
;有点选、框选、范围线3种选择方式
(defun c:g2d()
(setvar "cmdecho" 0)
(setq file (getfiled "文件保存为" "" "dat" 1))
(if (findfile file)
    (setq ff (open file "a"))
    (setq ff (open file "w"))
)
(setq xzfs (getint "\n高程点选择方式:[图上拾取( 1 )] / [选择范围线( 2 )]: < 1 >"))
(if (= xzfs nil) (setq xzfs 1))
(if (= xzfs 2)
    (progn
      (while (null (setq fwx (car (entsel "\n选择范围线(闭合多边形):")))))
      (setq bh (cdr (assoc 70 (entget fwx))))
      (if (or (= bh 0) (= bh 128))
      (progn
          (alert "你选择的范围线没有闭合")
          (while (null (setq fwx (car (entsel "\n选择范围线(闭合多边形):")))))
          (setq bh (cdr (assoc 70 (entget fwx))))
          (if (or (= bh 0) (= bh 128)) (exit))
      )
      )
      (setq fwxb (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget fwx))))
    )
)
(cond
    ((= xzfs 1) (setq ss (ssget '((0 . "insert") (2 . "gc200")))))
    ((= xzfs 2) (setq ss (ssget "wp" fwxb '((0 . "INSERT") (2 . "GC200")))))
)
(setq i 0)
(repeat (sslength ss)
    (setq en (ssname ss i))
    (setq en_data (entget en))
    (setq pt (cdr (assoc 10 en_data)))
    (setq i (1+ i))
    (setq str (strcat (rtos i 2 0) ",," (rtos (car pt) 2 3) ","(rtos (cadr pt) 2 3)","(rtos (caddr pt) 2 3)))
    (write-line str ff)
)
(close ff)
(princ (strcat "\n文件保存位置==>: " file))
(princ "\n本次总共提取了 ") (princ i) (princ " 个高程点")
(prin1)
)
(princ "\n蓝图测绘，精心制作; 键入 g2d 运行本插件")

chaojibiantai 发表于 2014-3-22 09:40:19

O(∩_∩)O谢谢分享

树櫴希德 发表于 2014-3-22 13:46:49

蓝图老师好样的

ningwy001 发表于 2014-5-27 20:49:42

谢谢学习学习

gzbccy 发表于 2014-7-26 08:11:28

高人很多啊。其实主要是加强学习下才可以

qunaihan 发表于 2014-8-21 12:25:32

蓝图大师的程序运行时出现这个：选择范围线(闭合多边形):; 错误: 参数类型错误: lselsetp nil。不知是哪里的问题？望指教。谢谢！！！

chbddzx12 发表于 2015-2-3 12:34:56

..........................

skg123 发表于 2015-8-11 14:26:54

当高程点 移动了，使用下面的程序读取 属性值（属性值=高程值）
(vl-load-com)
(defun c:TT()
(setq i 1)
(setq word (getstring "\n请输入断面编号:"))
(while
   (if (setq ent (car (entsel "\n请选取高程点:")))
         (if (= (cdr (assoc 0 (entget ent))) "INSERT")
             (if (= (vlax-get (setq obj (vlax-ename->vla-object ent)) "HasAttributes") -1)
               (progn
                  (setq att (vlax-invoke obj "GetAttributes"))
                  (setq jgb (mapcar '(lambda(aobj) (vlax-get aobj "TextString")
                                       )
                                       att
                              )
                  )
                  (princ word )(princ "号断面")(princ i )(princ "号点高程值：")(princ jgb) (princ "\n")
               )
             )
         )
      )

   (setq i (+ 1 i))
   (princ)
);end while
)

aumyshow 发表于 2021-3-6 22:50:20

谢谢分享
~~~~~~~~~~~~
页: 1 [2] 3
查看完整版本: 从CASS中提取高程点坐标输出至文本（图面连续拾取，可框选）【原】