(已解决)大神帮忙如何批量提取控制点名坐标高程至txt

song宋_74729

大神帮忙如何批量提取控制点名坐标高程至txt

谢谢,

song宋_74729

vitalgg 发表于 2022-4-25 18:31
写代码行不通的话，

直接用CAD的数据提取吧。 菜单- 工具- 数据提取。

(defun block:get-attributes (blk / lst)
  "获取块属性,返回属性名和值的点对列表。"
  (if (= (quote ename)
      (type blk))
    (if (safearray-value (setq lst (vlax-variant-value (vla-getattributes (vlax-ename->vla-object blk)))))
      (mapcar (quote (lambda (x)
            (cons (vla-get-tagstring x)
              (vla-get-textstring x))))
        (vlax-safearray->list lst)))
    nil))
;;;;;;;;;;;;;;;;
(defun pickset:to-list (ss)
  "选择集->像素列表"
  "像素列表"
  (if ss (vl-remove-if-not (quote p:enamep)
      (mapcar (quote cadr)
        (ssnamex ss)))
    nil))
;;;;;;;;;;;;;;;;;
(defun c:j1()
    (defun export-pt (/ fp)
      (setq fp (open (strcat "D:/"
                             (car (string:to-list (@:timestamp) "."))
                             ".txt")
                     "w"))
      (mapcar
       '(lambda(x)
          (setq att% (block:get-attributes x))
          (write-line
           (strcat (cdr (assoc "CNTP" att%))"," ;;名称
                   (string:from-list (mapcar '@:to-string (entity:getdxf x 10))",")","  ;;坐标
                   (cdr (assoc "ELEV" att%))"," ;;标高
                   (cdr (assoc "DESC" att%))) ;; 描述
           fp))
       (pickset:to-list (ssget "x" '((0 . "insert")(2 . "cpoint")))) ;; 所有块像素
       )
      (close fp)
      (@:cmd "notepad" filename) ;; 用 notepad 打开生成的文件
      (princ))

是这样吗

vitalgg

txt文件保存至 D:\ 时间戳 .txt
代码中的我自定义函数定义在 @lisp 函数库中。
安装@lisp后，可以直接运行下面的代码。

如果无法播放，请点击此处在新窗口打开

1. (defun export-pt (/ fp)
   
2.   (setq fp (open (strcat "D:/"
   
3.                          (car (string:to-list (@:timestamp) "."))
   
4.                          ".txt")
   
5.                  "w"))
   
6.   (mapcar
   
7.    '(lambda(x)
   
8.       (setq att% (block:get-attributes x))
   
9.       (write-line
   
10.        (strcat (cdr (assoc "CNTP" att%))"," ;;名称
    
11.                (string:from-list (mapcar '@:to-string (entity:getdxf x 10))",")","  ;;坐标
    
12.                (cdr (assoc "ELEV" att%))"," ;;标高
    
13.                (cdr (assoc "DESC" att%))) ;; 描述
    
14.        fp))
    
15.    (pickset:to-list (ssget "x" '((0 . "insert")(2 . "cpoint")))) ;; 所有块图元
    
16.    )
    
17.   (close fp)
    
18.   (@:cmd "notepad" filename) ;; 用 notepad 打开生成的文件
    
19.   (princ))

(defun export-pt (/ fp)<br />   (setq fp (open (strcat "D:/"<br />                          (car (string:to-list (@:timestamp) "."))<br />                          ".txt")<br />                  "w"))<br />   (mapcar<br />    '(lambda(x)<br />       (setq att% (block:get-attributes x))<br />       (write-line<br />        (strcat (cdr (assoc "CNTP" att%))"," ;;名称<br />                (string:from-list (mapcar '@:to-string (entity:getdxf x 10))",")","  ;;坐标<br />                (cdr (assoc "ELEV" att%))"," ;;标高<br />                (cdr (assoc "DESC" att%))) ;; 描述<br />        fp))<br />    (pickset:to-list (ssget "x" '((0 . "insert")(2 . "cpoint")))) ;; 所有块图元<br />    )<br />   (close fp)<br />   (@:cmd "notepad" filename) ;; 用 notepad 打开生成的文件<br />   (princ))

song宋_74729

(defun c:zhhua()
(princ "\n框选所需输出的点:")
(setq ss (ssget ))
(setq n (sslength ss))
(setq ff (open (getfiled "档保存为" "c:" "txt" 1) "w"))
(setq i 0)
(repeat n
  (setq spt (ssname ss i ))
  (setq ept (entget spt))
  (if (= (cdr (assoc 0 ept)) "POINT")
    (progn
      (setq lxyz (cdr (assoc 10 ept)))
      (setq sy (rtos (nth 0 lxyz)))
      (setq sx (rtos (nth 1 lxyz)))
      (setq sz1 (rtos (nth 2 lxyz)))
      (setq sxyz (strcat sx " " sy " " sz1))
      (write-line sxyz ff)
    )
  )
  (setq i (+ i 1))
);repeat
(princ "\n转换完毕")
)
还需要优化

song宋_74729

vitalgg 发表于 2022-4-24 07:04
txt文件保存至 D:\ 时间戳 .txt
代码中的我自定义函数定义在 @lisp 函数库中。
安装@lisp后，可以直接运 ...

大神帮忙 把缺的函数加进去,能够执行 感恩

vitalgg

song宋_74729 发表于 2022-4-24 08:24
大神帮忙 把缺的函数加进去,能够执行 感恩

到http://atlisp.cn 安装  @lisp 就有了，
或者你自己到网站复制。网站上有源码。


http: //atlisp. cn/function/funname
用你需要的函数名代替 funname
如 http://atlisp.cn/function/block:get-attributes
http://atlisp.cn/function/pickset:to-list

song宋_74729

  大神帮忙 把缺的函数加进去,  执行命令是甚么,帮忙添加修改比较快,

vitalgg

251 定制服务

song宋_74729

(defun c:pid()
(setq ff (open (getfiled "档保存为" "d:/" "txt" 1) "w"))
(setq pt "")
(while
(setq crname (getstring "\n 请输入点号名称 : "))  
(setq pt (getpoint "\n 读取输出坐标的点:"))
           (setq s (strcat crname"  " (rtos (nth 1 pt) 2 3) "     " (rtos (nth 0 pt) 2 3) "     " (rtos (nth 2 pt) 2 3)))
           (write-line s ff)
        (princ "\n")
        (princ (strcat "\n　已输出的文字为''" s "'"))
  (setq pt "")
   )
)
   

vitalgg

写代码行不通的话，

直接用CAD的数据提取吧。 菜单- 工具- 数据提取。

song宋_74729

vitalgg 发表于 2022-4-25 18:31
写代码行不通的话，

直接用CAD的数据提取吧。 菜单- 工具- 数据提取。

谢谢指点 数据提取没问题,我要的是点位编号