提取文字插入点坐标【测量坐标格式】

skg123

本程序提取文字的插入点坐标输出到文本
适应于 地图上只有文字 非 CASS格式的高程点
如下图

(defun c:TQWZZB()
   (princ "\n选择所需输出的点（point）:")
   (setq ss (ssget ));;选取坐标点
   (setq n (sslength ss ));计算坐标点数量
        (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径
   (setq i 0)
   (repeat n
  (setq spt (ssname ss i ))
    (setq ept (entget spt))
    (if (= (cdr (assoc 0 ept)) "TEXT")
     (progn
                                    (setq lxyz (cdr (assoc 10  ept)))
       (setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符
       (setq sy (rtos (nth 0 lxyz)))
       (setq sz (rtos (nth 2 lxyz)))
                                        (setq i1 (+ i 1));计算点序号
                                        (setq sn (rtos i1 2 0));将序号实数转换成字符
       (setq sxyz (strcat sn",,"  sy ","  sx  ","  sz))
       (write-line sxyz ff)
    )
    )
    (setq i (+ i 1))
   );repeat
)
(prompt "*只适合TEXT点 << 命令:TQWZZB >> *输出格式（点号,, Y，X，Z）**")
(prin1)

yefei812678

不错
不错
不错

xiabin68

不错，，，，，，，，

gzxl

不不错，，，，，，，，，，，，，，，，

skg123

某地形图 高程点如附件中所示，现在要提取高程点坐标值 几千个点，高程非CASS高程。文本的高程为 零 ，有个高程点在文本出入点的位置，带高程值。
操作步骤，首先删除所有高程点的文字，主要只删除文字，保留 “ 点”  然后运行程序 框选所有高程点就可以了。
方案2：删除无关的线，数据，然后运行程序，框选全部，把坐标提取
有兴趣的朋友自己去体会

2. (defun c:TQZB()
   
3. (princ "\n选择所需输出的点或文字:")
   
4. (setq ss (ssget ));;选取坐标点
   
5. (setq n (sslength ss ));计算坐标点数量
   
6. (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径
   
7. (setq i 0)
   
8. (repeat n
   
9. (setq spt (ssname ss i ))
   
10. (setq ept (entget spt))
    
11. (if (= (cdr (assoc 0 ept)) )
    
12. (progn
    
13. (setq lxyz (cdr (assoc 10 ept)))
    
14. (setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符
    
15. (setq sy (rtos (nth 0 lxyz)))
    
16. (setq sz (rtos (nth 2 lxyz)))
    
17. (setq i1 (+ i 1));计算点序号
    
18. (setq sn (rtos i1 2 0));将序号实数转换成字符
    
19. (setq sxyz (strcat sn",," sy "," sx "," sz))
    
20. (write-line sxyz ff)
    
21. )
    
22. )
    
23. (setq i (+ i 1))
    
24. );repeat
    
25. )
    
26. (prompt "*提取地图中的高程点坐标值 << 命令:TQZB >> *输出格式（点号,, Y，X，Z）**")
    
27. (prin1)

(defun c:TQZB()<br /> (princ "\n选择所需输出的点或文字:")<br /> (setq ss (ssget ));;选取坐标点<br /> (setq n (sslength ss ));计算坐标点数量<br /> (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径<br /> (setq i 0)<br /> (repeat n<br /> (setq spt (ssname ss i ))<br /> (setq ept (entget spt))<br /> (if (= (cdr (assoc 0 ept)) )<br /> (progn<br /> (setq lxyz (cdr (assoc 10 ept)))<br /> (setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符<br /> (setq sy (rtos (nth 0 lxyz)))<br /> (setq sz (rtos (nth 2 lxyz)))<br /> (setq i1 (+ i 1));计算点序号<br /> (setq sn (rtos i1 2 0));将序号实数转换成字符<br /> (setq sxyz (strcat sn",," sy "," sx "," sz))<br /> (write-line sxyz ff)<br /> )<br /> )<br /> (setq i (+ i 1))<br /> );repeat<br /> )<br /> (prompt "*提取地图中的高程点坐标值 << 命令:TQZB >> *输出格式（点号,, Y，X，Z）**")<br /> (prin1)

2. (defun c:TQZB()
   
3. (princ "\n选择所需输出的点或文字:")
   
4. (setq ss (ssget ));;选取坐标点
   
5. (setq n (sslength ss ));计算坐标点数量
   
6. (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径
   
7. (setq i 0)
   
8. (repeat n
   
9. (setq spt (ssname ss i ))
   
10. (setq ept (entget spt))
    
11. (if (= (cdr (assoc 0 ept)) )
    
12. (progn
    
13. (setq lxyz (cdr (assoc 10 ept)))
    
14. (setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符
    
15. (setq sy (rtos (nth 0 lxyz)))
    
16. (setq sz (rtos (nth 2 lxyz)))
    
17. (setq i1 (+ i 1));计算点序号
    
18. (setq sn (rtos i1 2 0));将序号实数转换成字符
    
19. (setq sxyz (strcat sn",," sy "," sx "," sz))
    
20. (princ"\n")
    
21. (prinC sxyz);命令行显示坐标值
    
22. 
    
23. (write-line sxyz ff)
    
24. 
    
25. )
    
26. )
    
27. (setq i (+ i 1))
    
28. );repeat
    
29. (close ff);关闭文件
    
30. )
    
31. 
    
32. (prompt "*提取地图中的高程点坐标值 << 命令:TQZB >> *输出格式（点号,, Y，X，Z）**")
    
33. (prin1)

(defun c:TQZB()<br /> (princ "\n选择所需输出的点或文字:")<br /> (setq ss (ssget ));;选取坐标点<br /> (setq n (sslength ss ));计算坐标点数量<br /> (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径<br /> (setq i 0)<br /> (repeat n<br /> (setq spt (ssname ss i ))<br /> (setq ept (entget spt))<br /> (if (= (cdr (assoc 0 ept)) )<br /> (progn<br /> (setq lxyz (cdr (assoc 10 ept)))<br /> (setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符<br /> (setq sy (rtos (nth 0 lxyz)))<br /> (setq sz (rtos (nth 2 lxyz)))<br /> (setq i1 (+ i 1));计算点序号<br /> (setq sn (rtos i1 2 0));将序号实数转换成字符<br /> (setq sxyz (strcat sn",," sy "," sx "," sz))<br /> (princ"\n")<br /> (prinC sxyz);命令行显示坐标值<br /> <br /> (write-line sxyz ff)<br /> <br /> )<br /> )<br /> (setq i (+ i 1))<br /> );repeat<br /> (close ff);关闭文件<br /> )<br /> <br /> (prompt "*提取地图中的高程点坐标值 << 命令:TQZB >> *输出格式（点号,, Y，X，Z）**")<br /> (prin1)

以下是改进版，可以将桩基的编号读取作为点号

2. ;;;;读取桩基的编号文本，将编号作为点号
   
3. (defun c:TQWZZB()
   
4.    (princ "\n选择所需输出的点（point）:")
   
5.    (setq ss (ssget ));;选取坐标点
   
6.    (setq n (sslength ss ));计算坐标点数量
   
7.         (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径
   
8.    (setq i 0)
   
9.    (repeat n
   
10.   (setq spt (ssname ss i ))
    
11.     (setq ept (entget spt))
    
12.     (if (= (cdr (assoc 0 ept)) "TEXT")
    
13.      (progn
    
14.                                     (setq lxyz (cdr (assoc 10  ept)))
    
15. setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符
    
16. (setq sX11 (rtos sx1 2 3))
    
17. 
    
18.        (setq sy (rtos (nth 0 lxyz)2 3))
    
19.        (setq sz (rtos (nth 2 lxyz)2 3))
    
20.                                         (setq i1 (+ i 1));计算点序号
    
21.                                         (setq sn (rtos i1 2 0));将序号实数转换成字符
    
22. ;;获取文本内容（编号）做点号
    
23. (setq ent (entget (ssname ss i)))
    
24. (setq typeA (cdr (assoc 1 ent)))
    
25. ;;;;
    
26.        (setq sxyz (strcat typeA"," sn ","  sy ","  sx  ","  sz))
    
27.        (write-line sxyz ff)
    
28.     )
    
29.     )
    
30.     (setq i (+ i 1))
    
31.    );repeat
    
32. )
    
33. (prompt "*只适合TEXT点 << 命令:TQWZZB >> *输出格式（点号,, Y，X，Z）**")
    
34. (prin1)
    

;;;;读取桩基的编号文本，将编号作为点号<br /> (defun c:TQWZZB()<br />    (princ "\n选择所需输出的点（point）:")<br />    (setq ss (ssget ));;选取坐标点<br />    (setq n (sslength ss ));计算坐标点数量<br />         (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径<br />    (setq i 0)<br />    (repeat n<br />   (setq spt (ssname ss i ))<br />     (setq ept (entget spt))<br />     (if (= (cdr (assoc 0 ept)) "TEXT")<br />      (progn<br />                                     (setq lxyz (cdr (assoc 10  ept)))<br /> setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符<br /> (setq sX11 (rtos sx1 2 3))<br /> <br />        (setq sy (rtos (nth 0 lxyz)2 3))<br />        (setq sz (rtos (nth 2 lxyz)2 3))<br />                                         (setq i1 (+ i 1));计算点序号<br />                                         (setq sn (rtos i1 2 0));将序号实数转换成字符<br /> ;;获取文本内容（编号）做点号<br /> (setq ent (entget (ssname ss i)))<br /> (setq typeA (cdr (assoc 1 ent)))<br /> ;;;;<br />        (setq sxyz (strcat typeA"," sn ","  sy ","  sx  ","  sz))<br />        (write-line sxyz ff)<br />     )<br />     )<br />     (setq i (+ i 1))<br />    );repeat<br /> )<br /> (prompt "*只适合TEXT点 << 命令:TQWZZB >> *输出格式（点号,, Y，X，Z）**")<br /> (prin1)<br />

dwjb

楼主厉害很强大，我一直用cass的数据交换功能，转入excel，宏，ok了

yshf

改为如下，对“地形1.dwg”在不删除其它图元的情况下取得高程点的平面坐标及高程值

2. 
   
3. 
   
4. (defun c:TQZB()
   
5.     (princ "\n选择所需输出的点或文字:")
   
6.     (if (setq ss (ssget '((0 . "INSERT") (2 . "DOT-1"))));;选取高程点
   
7.         (progn
   
8.             (setq n (sslength ss ));计算坐标点数量
   
9.             (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径
   
10.      ;(setq ff (open (getfiled "文件保存为" "f:/" "csv" 1) "w"));将上一行注释，启用本行，所得文件可用Excel打开
    
11.             (setq i 0)
    
12.             (repeat n
    
13.                 (setq ept  (entget (ssname ss i))
    
14.         lxyz (cdr (assoc 10 ept))
    
15.         i    (1+ i)
    
16.   )
    
17.                 (princ
    
18.       (strcat
    
19.           (itoa i)  ",,"              ;点号
    
20.           (rtos (cadr lxyz) 2 3) ","  ;X坐标值
    
21.           (rtos (car  lxyz) 2 3) ","  ;Y坐标值
    
22.           (rtos (last lxyz) 2 3) "\n" ;高程值
    
23.       )
    
24.       ff
    
25.   )
    
26.             );end repeat
    
27.      (close ff);关闭文件
    
28.          );end progn
    
29.     );end if
    
30.     (princ)
    
31. )
    
32. (prompt "*提取地图中的高程点坐标值 << 命令:TQZB >> *输出格式(点号,, Y，X，Z)**")

<br /> <br /> (defun c:TQZB()<br />     (princ "\n选择所需输出的点或文字:")<br />     (if (setq ss (ssget '((0 . "INSERT") (2 . "DOT-1"))));;选取高程点<br />         (progn<br />             (setq n (sslength ss ));计算坐标点数量<br />             (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径<br />      ;(setq ff (open (getfiled "文件保存为" "f:/" "csv" 1) "w"));将上一行注释，启用本行，所得文件可用Excel打开<br />             (setq i 0)<br />             (repeat n<br />                 (setq ept  (entget (ssname ss i))<br />         lxyz (cdr (assoc 10 ept))<br />         i    (1+ i)<br />   )<br />                 (princ<br />       (strcat<br />           (itoa i)  ",,"              ;点号<br />           (rtos (cadr lxyz) 2 3) ","  ;X坐标值<br />           (rtos (car  lxyz) 2 3) ","  ;Y坐标值<br />           (rtos (last lxyz) 2 3) "\n" ;高程值<br />       )<br />       ff<br />   )<br />             );end repeat<br />      (close ff);关闭文件<br />          );end progn<br />     );end if<br />     (princ)<br /> )<br /> (prompt "*提取地图中的高程点坐标值 << 命令:TQZB >> *输出格式(点号,, Y，X，Z)**")

万里天

我的是vba写的.

zyhandw

看来这个问题大家都碰到了，我也自己写了个

linshiyin2

我也得自己写一个了，又遇到这个问题了

xiaoguben

好东西。。。。。。。。。。。。。。