将CAD断面图中所需数据导入到指定的EXCEL表格

lizhgang.jin

已经画了很多很多断面图了，以前将每个断面图的桩号和对应的面积输入到计算表的时候即费时又容易出错。见贵论坛的编程大师真是很多，而且很乐于帮助我，今天又来劳烦各位大师了，希望能解决我的问题。想达到的效果是：运行工具后，根据提示选择第一个断面桩号，再选对应的面积，依次类推，直到选完，然后桩号和面积自动输入到C 盘下我给定样式的表格中。图中的桩号和面积都是我自己量好的，不须要大师再编程量。只需提取对应的桩号及面积到我指定样式的表格中即可。希望大师再次伸出您们友爱的手，让我从几百个断面面积输入中解脱出来，提前感谢了。具体excel样式及CAD图在我发的附件里。(好像有点难度）

st788796

lizhgang.jin 发表于 2015-1-14 16:19
老师是我的错，我以为您都做了最难的部分，其它的部分应该是举手之劳，我想错了。不过还想请您改一下下， ...

用模板文件最好是一次写出，否则中断后再去判断往哪个格写更麻烦

如果是希望点一个写一个就像上面写的，停止后其它的自己在Excel中手动处理

st788796

直接框选就可以，不必一个个拾取

zhenyoucai

我也想知道答案

st788796

直接框选，注意要一一对应

1. (defun c:tt (/ ss lst)
   
2.   (if (setq ss (ssget '((0 . "*Text"))))
   
3.     (progn
   
4.       (setq
   
5.         lst (mapcar
   
6.               '(lambda (x)
   
7.                  (if (= (xdrx_getpropertyvalue x "IsA") "AcDbText")
   
8.                    (xdrx_getpropertyvalue x "Position" "Textstring")
   
9.                    (xdrx_getpropertyvalue x "Location" "Textstring")
   
10.                  )
    
11.                )
    
12.               (xdrx_pickset->ents ss)
    
13.             )
    
14.         lst (xd::list:groupbyindex lst 18.0) ;_根据行距自己调整
    
15.         lst (mapcar '(lambda (x)
    
16.                        (mapcar '(lambda        (a / i)
    
17.                                   (acad_strlsort
    
18.                                     (if        (wcmatch a "引*")
    
19.                                       (progn
    
20.                                         (or (setq
    
21.                                               i        (vl-string-search "-" a)
    
22.                                             )
    
23.                                             (setq
    
24.                                               i        (vl-string-search "+" a)
    
25.                                             )
    
26.                                         )
    
27.                                         (substr a (1+ i))
    
28.                                       ) ;_0
    
29.                                       (car (xdrx_string_regexps
    
30.                                              "[0-9]+.[0-9]+"
    
31.                                              a
    
32.                                            )
    
33.                                       )
    
34.                                     )
    
35.                                   )
    
36.                                 )
    
37.                                x
    
38.                        )
    
39.                      )
    
40.                     (mapcar 'cdr (cdr lst))
    
41.             )
    
42.         lst (vl-sort lst '(lambda (x1 x2) (< (car x1) (car x2))))
    
43.       )
    
44.       (xdex_book_open "c:/桩号面积.xls");_自己做好模板文件放到 C 盘
    
45.       (xdex_book_getActiveSheet)
    
46.       (xdex_cell_writerange 2 0 t lst)
    
47.       (xdex_book_save)
    
48.       (xdex_book_close)
    
49.     )
    
50.   )
    
51.   (princ)
    
52. )
    

(defun c:tt (/ ss lst)<br />   (if (setq ss (ssget '((0 . "*Text"))))<br />     (progn<br />       (setq<br />         lst (mapcar<br />               '(lambda (x)<br />                  (if (= (xdrx_getpropertyvalue x "IsA") "AcDbText")<br />                    (xdrx_getpropertyvalue x "Position" "Textstring")<br />                    (xdrx_getpropertyvalue x "Location" "Textstring")<br />                  )<br />                )<br />               (xdrx_pickset->ents ss)<br />             )<br />         lst (xd::list:groupbyindex lst 18.0) ;_根据行距自己调整<br />         lst (mapcar '(lambda (x)<br />                        (mapcar '(lambda        (a / i)<br />                                   (acad_strlsort<br />                                     (if        (wcmatch a "引*")<br />                                       (progn<br />                                         (or (setq<br />                                               i        (vl-string-search "-" a)<br />                                             )<br />                                             (setq<br />                                               i        (vl-string-search "+" a)<br />                                             )<br />                                         )<br />                                         (substr a (1+ i))<br />                                       ) ;_0<br />                                       (car (xdrx_string_regexps<br />                                              "[0-9]+.[0-9]+"<br />                                              a<br />                                            )<br />                                       )<br />                                     )<br />                                   )<br />                                 )<br />                                x<br />                        )<br />                      )<br />                     (mapcar 'cdr (cdr lst))<br />             )<br />         lst (vl-sort lst '(lambda (x1 x2) (< (car x1) (car x2))))<br />       )<br />       (xdex_book_open "c:/桩号面积.xls");_自己做好模板文件放到 C 盘<br />       (xdex_book_getActiveSheet)<br />       (xdex_cell_writerange 2 0 t lst)<br />       (xdex_book_save)<br />       (xdex_book_close)<br />     )<br />   )<br />   (princ)<br /> )<br />

lizhgang.jin

st788796 发表于 2015-1-12 15:27
直接框选，注意要一一对应

选择对象:
; 错误: no function definition: XD::LIST:GROUPBYINDEX

老师我的CAD不知什么问题按论坛说的方法加载晓东的那个插件总是错误我是CAD2005，要是能不需多余加载就能直接导入到我提供的EXCEL中就好了。
有两点进行说明一下：
1、还是不要框选取，因为我们测量一个断面图上可能要标好几个面积，那几个面积在断面图上可能不是像我这样放在桩号下面，我只是为了便于查看才标到桩号下面的，而且可能一个桩号既有开挖面积也有回填面积等（如果是大坝填筑量那按填筑料分面积还要多些），所以还是人工对应的选，以方便计算不同的工程量。
2、程序最好是直接的LSP文件。因为虽然晓东工具很强大，但说实话有的CAD 装的软件较多，容易出线不兼容，老出错。比方我们搞测量的就装了CASS/纬地道路、飞时达等很多常用软件。麻烦了。

最后需要的同志和有更好创意的同学们帮顶一下了。

csharp

lizhgang.jin 发表于 2015-1-12 17:18
选择对象:
; 错误: no function definition: XD:IST:GROUPBYINDEX

点选前处理简单，有思路了去找对应api的v/alisp函数替代即可

lizhgang.jin

xd-lisp-lib.vlx我的级别不够下不了

lizhgang.jin

st788796 发表于 2015-1-12 15:27
直接框选，注意要一一对应

老师我说的建议能弄吗？

lizhgang.jin

csharp 发表于 2015-1-12 17:51
点选前处理简单，有思路了去找对应api的v/alisp函数替代即可

老师我的建议能弄吗

XDSoft

lizhgang.jin 发表于 2015-1-12 19:18
xd-lisp-lib.vlx我的级别不够下不了

你再有3个积分就够了。

lizhgang.jin

XDSoft 发表于 2015-1-13 21:26
你再有3个积分就够了。

好的能下了，再试试

lizhgang.jin

lizhgang.jin 发表于 2015-1-13 21:35
好的能下了，再试试

{:soso_e100:}

lizhgang.jin

lizhgang.jin 发表于 2015-1-12 17:18
选择对象:
; 错误: no function definition: XD:IST:GROUPBYINDEX

楼主的程序我终于可以试用了，很可惜运行没有结果，EXCEL表格里没任何东西。
我的需求的本质就是提取CAD中的文本到EXCEL特定单元格，要能批量。数字前面的汉字和符号，这些都不要紧我自己可以批处理。不知楼主编的程序试运行没有，我运行不成功。

st788796

lizhgang.jin 发表于 2015-1-13 22:39
楼主的程序我终于可以试用了，很可惜运行没有结果，EXCEL表格里没任何东西。
我的需求的本质就是提取CAD ...

给你用 COM 方式写个例子，只考虑新建文件，不考虑追加
拾取过滤及字符串处理使用 XDAPI

1. (defun c:tt (/ _putcelltext excel wks sht _range cells zh area e a str1 str2)
   
2.   (defun _putcelltext (cells row col str /)
   
3.     (vlax-invoke
   
4.       (vlax-get-property
   
5.         (vlax-get-property _range 'offset row (1- col))
   
6.         'Resize
   
7.         2
   
8.       )
   
9.       'Merge
   
10.     )
    
11.     (vlax-put-property
    
12.       (variant-value
    
13.         (vlax-get-property
    
14.           cells
    
15.           'Item
    
16.           (cond
    
17.             ((zerop row) 1)
    
18.             ((= row 1) 3)
    
19.             (t (+ 2 row))
    
20.           )
    
21.           col
    
22.         )
    
23.       )
    
24.       'value2
    
25.       str
    
26.     )
    
27.   )
    
28.   (if (setq excel (vlax-create-object "Excel.Application"))
    
29.     (progn
    
30.       (vlax-put excel "Visible" 1)
    
31.       (setq wks (vlax-get excel 'WorkBooks))
    
32.       (vlax-invoke wks 'Add)
    
33.       (setq sht           (vlax-get excel 'ActiveSheet)
    
34.             _range (vlax-get-property sht 'Range "A1")
    
35.             cells  (vlax-get sht 'Cells)
    
36.       )
    
37.       (setq j 0)
    
38.       (vlax-put-property
    
39.         (vlax-get-property sht 'Columns)
    
40.         'HorizontalAlignment
    
41.         3
    
42.       )
    
43.       (_putcelltext cells 0 1 "桩号")
    
44.       (_putcelltext cells 0 2 "断面面积")
    
45.       (while (and (setq
    
46.                     e (car (xdrx_entsel "\n拾取桩号: " '((1 . "引*"))))
    
47.                   )
    
48.                   (setq str1 (xdrx_getpropertyvalue e "textstring"))
    
49.                   (setq
    
50.                     a (car (xdrx_entsel "\n拾取面积.:" '((1 . "S=*"))))
    
51.                   )
    
52.                   (setq str2 (xdrx_getpropertyvalue a "textstring"))
    
53.              )
    
54.         (or (setq i (vl-string-search "-" str1))
    
55.             (setq i (vl-string-search "+" str1))
    
56.         )
    
57.         (setq zh (substr str1 (1+ i))) ;_0
    
58.         (setq area (car        (xdrx_string_regexps
    
59.                           "[0-9]+.[0-9]+"
    
60.                           str2
    
61.                         )
    
62.                    )
    
63.         )
    
64.         (_putcelltext cells (1+ j) 1 zh)
    
65.         (_putcelltext cells (1+ j) 2 area)
    
66.         (setq j (+ 2 j))
    
67.       )
    
68.       (vlax-invoke
    
69.         (vlax-get excel 'activeworkbook)
    
70.         'Saveas
    
71.         "c:\\桩号面积.xls"
    
72.       )
    
73.       (vlax-release-object excel)
    
74.     )
    
75.   )
    
76.   (princ)
    
77. )
    

(defun c:tt (/ _putcelltext excel wks sht _range cells zh area e a str1 str2)<br />   (defun _putcelltext (cells row col str /)<br />     (vlax-invoke<br />       (vlax-get-property<br />         (vlax-get-property _range 'offset row (1- col))<br />         'Resize<br />         2<br />       )<br />       'Merge<br />     )<br />     (vlax-put-property<br />       (variant-value<br />         (vlax-get-property<br />           cells<br />           'Item<br />           (cond<br />             ((zerop row) 1)<br />             ((= row 1) 3)<br />             (t (+ 2 row))<br />           )<br />           col<br />         )<br />       )<br />       'value2<br />       str<br />     )<br />   )<br />   (if (setq excel (vlax-create-object "Excel.Application"))<br />     (progn<br />       (vlax-put excel "Visible" 1)<br />       (setq wks (vlax-get excel 'WorkBooks))<br />       (vlax-invoke wks 'Add)<br />       (setq sht           (vlax-get excel 'ActiveSheet)<br />             _range (vlax-get-property sht 'Range "A1")<br />             cells  (vlax-get sht 'Cells)<br />       )<br />       (setq j 0)<br />       (vlax-put-property<br />         (vlax-get-property sht 'Columns)<br />         'HorizontalAlignment<br />         3<br />       )<br />       (_putcelltext cells 0 1 "桩号")<br />       (_putcelltext cells 0 2 "断面面积")<br />       (while (and (setq<br />                     e (car (xdrx_entsel "\n拾取桩号: " '((1 . "引*"))))<br />                   )<br />                   (setq str1 (xdrx_getpropertyvalue e "textstring"))<br />                   (setq<br />                     a (car (xdrx_entsel "\n拾取面积.:" '((1 . "S=*"))))<br />                   )<br />                   (setq str2 (xdrx_getpropertyvalue a "textstring"))<br />              )<br />         (or (setq i (vl-string-search "-" str1))<br />             (setq i (vl-string-search "+" str1))<br />         )<br />         (setq zh (substr str1 (1+ i))) ;_0<br />         (setq area (car        (xdrx_string_regexps<br />                           "[0-9]+.[0-9]+"<br />                           str2<br />                         )<br />                    )<br />         )<br />         (_putcelltext cells (1+ j) 1 zh)<br />         (_putcelltext cells (1+ j) 2 area)<br />         (setq j (+ 2 j))<br />       )<br />       (vlax-invoke<br />         (vlax-get excel 'activeworkbook)<br />         'Saveas<br />         "c:\\桩号面积.xls"<br />       )<br />       (vlax-release-object excel)<br />     )<br />   )<br />   (princ)<br /> )<br />