[编程申请]：在CAD中读取坐标数据，生成数据文件

jsrlb

俺编啦个小程序，可以把指定点的数据输出成电子表格文件(.xls)

;;;输出数学坐标-----------------------------------------------------------------------
(defun C:BGPT1 (/ nam f n1 n2 pt)
  (if (setq nam (getfiled "数学坐标数据保存至(电子表格.xls): " "" "xls" 9))
    (progn
      (setq f (open nam "w"))
      (write-line "数学坐标" f)
      (write-line "X        Y        Z" f)
      (setq n1 0)
      (while (setq pt (getpoint "\n坐标点<退出> : "))
        (write-line
          (strcat (rtos (car pt) 2 2)
                  "        "
                  (rtos (cadr pt) 2 2)
                  "        "
                  (rtos (caddr pt) 2 2)
          )
          f
        )
        (setq n1 (1+ n1))
      )
      (setq n2 (strcat "共" (rtos n1) "组数据"))
      (prin1 n2 f)
      (close f)
    )
  )
  (princ)
)
;;;------------------------------------------------------------------------



;;;输出地理坐标------------------------------------------------------------------------
(defun C:BGPT2 (/ nam f n1 n2 pt)
  (if (setq nam (getfiled "地理坐标数据保存至(电子表格.xls): " "" "xls" 9))
    (progn
      (setq f (open nam "w"))
      (write-line "地理坐标" f)
      (write-line "X        Y        Z" f)
      (setq n1 0)
      (while (setq pt (getpoint "\n坐标点<退出> : "))
        (write-line
          (strcat (rtos (cadr pt) 2 2)
                  "        "
                  (rtos (car pt) 2 2)
                  "        "
                  (rtos (caddr pt) 2 2)
          )
          f
        )
        (setq n1 (1+ n1))
      )
      (setq n2 (strcat "共" (rtos n1) "组数据"))
      (prin1 n2 f)
      (close f)
    )
  )
  (princ)
)
;;;-------------------------------------------------------------------

hsb-hy

最初由 jsrlb 发布
[B]俺编啦个小程序，可以把指定点的数据输出成电子表格文件(.xls)

;;;输出数学坐标-----------------------------------------------------------------------
(defun C:BGPT1 (/ nam f n1 n2 pt)
  (if (setq nam... [/B]

你好！
与主题不符，要求生成的是.dat文件

zbweixkj

仅只是支持点取而以，对等高线那样大量数据，还是不怎么适用，希望楼主能修改一下以便支持框取功能，框内所有线段的数据都能一次性提取，那就好了。.XLS格式文件很容易转换成。DAT文件的。

hsb-hy

看来是没有人能够帮忙了！

zjyxks

能帮我传一个么?  cqzjy1979@163.com

caddog

我自已编写了一个小程序
;;;输出图形中所有904层的点实体的X　Y　Z值
(DEFUN C:TXTOUT        (/ SS1 %REP %ID #TEMP $F1 $X $Y $Z $XYZ)
  (SETVAR "dimzin" 0)
  (SETQ %ID 0)
  (SETQ SS1 (SSGET '((0 . "POINT") (8 . "904"))))
  (SETQ %REP (SSLENGTH SS1))
  (SETQ $F1 (OPEN "D:\\高程点坐标文件.DAT" "w"))
  (WRITE-LINE "\"X\",\"Y\",\"Z\(Elevation\)\"" $F1)
  (REPEAT %REP
    (SETQ E-NAME1 (SSNAME SS1 %ID))
    (SETQ #TEMP (ENTGET E-NAME1))
    (SETQ #P1 (CDR (ASSOC 10 #TEMP)))
    (SETQ $X (RTOS (CAR #P1) 2 3))
    (SETQ $Y (RTOS (CADR #P1) 2 3))
    (SETQ $Z (RTOS (CADDR #P1) 2 3))
    (SETQ $XYZ (STRCAT $X "," $Y "," $Z))
    (WRITE-LINE $XYZ $F1)
    (SETQ %ID (+ 1 %ID))
  ) ;_ 结束REPEAT
  (CLOSE $F1)
) ;_ 结束DEFUN

;;;==========================
生成的文件格式像这样，前面要流水号的话将程序做点小小的修改就行了

"X","Y","Z(Elevation)"
598261.359,23002.586,626.976
598268.453,23008.933,626.970
598252.727,23024.332,627.092
598254.899,23011.063,626.940
598263.298,23020.481,626.897
598279.989,23004.071,626.933
598342.020,23015.032,637.945
598376.059,23012.260,649.845
598368.164,23028.532,650.288
598344.125,23069.910,659.133
598359.770,23070.004,664.660


改了一下程序，输出的结果像这样

"X","Y","Z(Elevation)"
1,29245.438,14162.236,518.951
2,29315.550,14143.703,517.456
3,29263.699,14173.036,517.068
4,29263.815,14171.403,517.027
5,29262.909,14171.240,517.042
6,29315.776,14141.273,518.003
7,29278.984,14171.540,516.734
8,29312.726,14116.615,517.992
9,29278.824,14167.933,516.706
10,29283.836,14161.279,516.644
11,29311.550,14116.040,518.086

;;;输出图形中所有904层的点实体的X　Y　Z值
(DEFUN C:TXTOUT        (/ SS1 %REP %ID #TEMP $F1 $X $Y $Z $XYZ)
  (SETVAR "dimzin" 0)
  (SETQ %ID 0)
  (SETQ SS1 (SSGET '((0 . "POINT") (8 . "904"))))
  (SETQ %REP (SSLENGTH SS1))
  (SETQ $F1 (OPEN "D:\\高程点坐标文件.DAT" "w"))
  (WRITE-LINE "\"X\",\"Y\",\"Z\(Elevation\)\"" $F1)
  (REPEAT %REP
    (SETQ E-NAME1 (SSNAME SS1 %ID))
    (SETQ #TEMP (ENTGET E-NAME1))
    (SETQ #P1 (CDR (ASSOC 10 #TEMP)))
    (SETQ $X (RTOS (CAR #P1) 2 3))
    (SETQ $Y (RTOS (CADR #P1) 2 3))
    (SETQ $Z (RTOS (CADDR #P1) 2 3))
    (SETQ $XYZ (STRCAT (itoa (+ %ID 1))"," $X "," $Y "," $Z))
    (WRITE-LINE $XYZ $F1)
    (SETQ %ID (+ 1 %ID))
  ) ;_ 结束REPEAT
  (CLOSE $F1)
) ;_ 结束DEFUN

g174157601

;;;点坐标写出文件
(defun c:test ()
  ;(CMDLA0)
  (setq ffn (getfiled "\n保存的坐标文件" "坐标" "txt" 1)
ff  (open ffn "w")
ss  (ssget '((0 . "POINT")))
i   -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (setq pt (dxf 10 (entget s1))
   tx (strcat (rtos (car pt) 2 3)
       " "
       (rtos (cadr pt) 2 3)
       " "
       (rtos (caddr pt) 2 3)
      )
    )
    (write-line tx ff)
  )
  (close ff)
  (princ (strcat "\n 坐标写至=>" ffn))
  ;(CMDLA1)
  (princ)
)
(defun dxf (code elist) (cdr (assoc code elist)))

hsb-hy

感谢狗各位的热心帮助！
要求：
1、选择或新建一个文件（文件扩展名.dat）；
2、点取指定点，在点位附近生成序号（流水序号）；
3、同时提取该点的坐标信息（文件格式：点号，x坐标，y坐标，z坐标）。

rjf810120

来个坐标标注

ls_bocai

5楼楼主说：   9pt 10pt 11pt 12pt 13pt 15pt  

给我地址,我发给你.这玩意我刚编好.分享.  


能不能给我发个啊　，我是个LISP的初学者，正在学这方面的　，不胜感激！
地址：ｌｕｏｓｈａｎ＠ｓｃｓｅｄｃ．ｃｎ

david96007

2. 
   
3. ;;;拾取Cad点坐标生成数据文件，程序是在d盘根目录下生成一个node.txt文件
   
4. ;;;'write by Hejian 2002 free to copy
   
5. 
   
6. 
   
7. (defun c:nd (/ kw fil cont esel oldos num1 pt pttext s s1 va pt1 pt2 l n fid)
   
8. 
   
9.   (initget "O N")
   
10.   (setq kw (getkword "\n[建立新文件(N)/打开文件(O)]<O>:"))
    
11.   (if kw
    
12.     (progn
    
13.       (setq fil        (strcat        "d://"
    
14.                         (getstring "[输入文件名(*.dat)]<node>:")
    
15.                         ".dat"
    
16.                 )
    
17.       )
    
18.       (setq input 0)
    
19. 
    
20.     )
    
21.     (progn
    
22.       (setq fil (getfiled "\nSelect a Dat File" "D:/" "dat" 8))
    
23.       (setq fid (open fil "r"))
    
24.       (setq lin (read-line fid))
    
25.       (while lin
    
26.         (setq end lin)
    
27.         (setq lin (read-line fid))
    
28.       )
    
29.       (close fid)
    
30.       (setq l (vl-string-position (ascii ",") end))
    
31.       (setq n (atoi (substr end 1 l)))
    
32.       (setq input n)
    
33. 
    
34. 
    
35.     )
    
36.   )
    
37.   (if (= nil fil)
    
38.     (setq fil "d://node.dat")
    
39.   )
    
40.   (graphscr)
    
41.   (setq pt (getpoint "\nplease pick a point:"))
    
42.   (while pt
    
43.     (setvar "cmdecho" 0)
    
44.     (setq
    
45.           input        (1+ input)
    
46.           s2        (strcat "\nnode number< " (itoa input))
    
47.           s2        (strcat s2 ">")
    
48.     )
    
49.     (initget 6)
    
50.     (setq num1 (getint s2))
    
51.     (if        (/= num1 nil)
    
52.       (setq input num1)
    
53.     )
    
54.     (setq pttext (list (+ (car pt) 0.05) (cadr pt) (caddr pt))
    
55.           s         (itoa input)
    
56.     )
    
57. 
    
58.     (setq s1 s)
    
59.     (setq va (cadr pt))
    
60. ;;;cadr得到y坐标
    
61.     (setq s1 (strcat s1 ","))
    
62.     (setq s1 (strcat s1 (rtos va 2 3)))
    
63.     (setq va (car pt))
    
64. ;;;car得到x坐标
    
65.     (setq s1 (strcat s1 ","))
    
66.     (setq s1 (strcat s1 (rtos va 2 3)))
    
67. 
    
68.     (setq va (caddr pt))
    
69.     (setq s1 (strcat s1 ","))
    
70.     (setq s1 (strcat s1 (rtos va 2 3)))
    
71.     (command "layer" "m" "序号层" "s" "序号层" "")
    
72.     (command "text" (trans pttext 0 1) "" "" s)
    
73.     (command "ucs" "")
    
74.     (setq fid (open fil "a"))
    
75.     (write-line s1 fid)
    
76.     (close fid)
    
77.     (setq pt (getpoint "\n点取下一点，回车退出:"))
    
78.   )
    
79.   (princ)
    
80. 
    
81. )
    

<br /> ;;;拾取Cad点坐标生成数据文件，程序是在d盘根目录下生成一个node.txt文件<br /> ;;;'write by Hejian 2002 free to copy<br /> <br /> <br /> (defun c:nd (/ kw fil cont esel oldos num1 pt pttext s s1 va pt1 pt2 l n fid)<br /> <br />   (initget "O N")<br />   (setq kw (getkword "\n[建立新文件(N)/打开文件(O)]<O>:"))<br />   (if kw<br />     (progn<br />       (setq fil        (strcat        "d://"<br />                         (getstring "[输入文件名(*.dat)]<node>:")<br />                         ".dat"<br />                 )<br />       )<br />       (setq input 0)<br /> <br />     )<br />     (progn<br />       (setq fil (getfiled "\nSelect a Dat File" "D:/" "dat" 8))<br />       (setq fid (open fil "r"))<br />       (setq lin (read-line fid))<br />       (while lin<br />         (setq end lin)<br />         (setq lin (read-line fid))<br />       )<br />       (close fid)<br />       (setq l (vl-string-position (ascii ",") end))<br />       (setq n (atoi (substr end 1 l)))<br />       (setq input n)<br /> <br /> <br />     )<br />   )<br />   (if (= nil fil)<br />     (setq fil "d://node.dat")<br />   )<br />   (graphscr)<br />   (setq pt (getpoint "\nplease pick a point:"))<br />   (while pt<br />     (setvar "cmdecho" 0)<br />     (setq<br />           input        (1+ input)<br />           s2        (strcat "\nnode number< " (itoa input))<br />           s2        (strcat s2 ">")<br />     )<br />     (initget 6)<br />     (setq num1 (getint s2))<br />     (if        (/= num1 nil)<br />       (setq input num1)<br />     )<br />     (setq pttext (list (+ (car pt) 0.05) (cadr pt) (caddr pt))<br />           s         (itoa input)<br />     )<br /> <br />     (setq s1 s)<br />     (setq va (cadr pt))<br /> ;;;cadr得到y坐标<br />     (setq s1 (strcat s1 ","))<br />     (setq s1 (strcat s1 (rtos va 2 3)))<br />     (setq va (car pt))<br /> ;;;car得到x坐标<br />     (setq s1 (strcat s1 ","))<br />     (setq s1 (strcat s1 (rtos va 2 3)))<br /> <br />     (setq va (caddr pt))<br />     (setq s1 (strcat s1 ","))<br />     (setq s1 (strcat s1 (rtos va 2 3)))<br />     (command "layer" "m" "序号层" "s" "序号层" "")<br />     (command "text" (trans pttext 0 1) "" "" s)<br />     (command "ucs" "")<br />     (setq fid (open fil "a"))<br />     (write-line s1 fid)<br />     (close fid)<br />     (setq pt (getpoint "\n点取下一点，回车退出:"))<br />   )<br />   (princ)<br /> <br /> )<br />

hsb-hy

最初由  发布
[B][code]
;;;拾取Cad点坐标生成数据文件，程序是在d盘根目录下生成一个node.txt文件
;;;'write by Hejian 2002 free to copy


(defun c:nd (/ kw fil cont esel oldos num1 pt pttext s s1 va pt1 pt2 l n fid)
... [/B]

感谢你david96007对我的帮助，完全满足我的要求！再次感谢！

hq740311

先谢谢了，邮箱为hq740311@sohu.com

李军

能给我吗？
jjun2003@163.com

jx2008

各位的程序非常好，多谢了