|
|
发表于 2009-11-14 08:21:05
|
显示全部楼层
来自： 中国
使用下面代码前,必须先在VBAIDE中引用EXCEL类库
( E/ I' J+ i% v; C* R5 x1 E- Sub TableToExcel()
, ~6 E7 c& y6 Z5 B: U; o# r - Dim SS As AcadSelectionSet '声明一个选择集对象变量,用于从屏幕上选择CAD表格对象
6 C! D6 F5 ]% |; _' j1 A# o - Dim FT(0) As Integer, FD(0) As Variant '声明选择集过滤器,用于限制从屏幕上选择的对象类型7 n# f$ J; L4 V$ q
- Dim T As AcadTable '声明一个CAD表格变量
& N! W5 H$ H/ G/ S# M& L% k f - ) a4 U, x9 \; k' c' I' Y% Y2 E
- FT(0) = 0 '设置选择集过滤器,限制从屏幕上选择的对象仅限于CAD表格,而不是其它对象" U0 q- `8 e# v
- FD(0) = "ACAD_TABLE"
+ u X1 v) ?; I/ U8 T% L+ B - With ThisDrawing5 A9 ~/ p7 ]) D5 _7 E
- Set SS = .SelectionSets.Add("SS") '新建选择集
a( S, M1 L# i. s! I! | - On Error Resume Next
# x& S: S( n8 F - SS.SelectOnScreen FT, FD '从屏幕上选取CAD表格对象- o+ `% D8 g- ]5 a. a* G! R _
- If Err Then Exit Sub
' s3 `0 C# J, v5 a+ ? - If SS.Count > 0 Then '如果有效选取了表格对象8 |& @# A" K5 V6 [' K6 R
- Set T = SS.Item(SS.Count - 1)'如果选择了多个CAD表格对象,只对最后一个进行处理
3 R" k( M0 Y, T# m" ^1 O- T" ` - 9 Y$ g( d0 `+ G, ?6 m+ [
- Dim E As New Excel.Application '声明并启动一个EXCEL进程- ~& |5 `9 ?$ T V- N3 S& C. F
- Dim B As Workbook '声明一个EXCEL工作簿变量
4 u7 T8 L- F5 a+ i9 d; o - Dim I As Long, J As Long '循环变量
* H# y+ L) l# {8 i7 x - + G! e# ~: O6 P, X1 I7 A
- E.Visible = True '新启动的EXCEL进程对用户是可见的) J$ [% S" I2 x& c: K
- Set B = E.Workbooks.Add '新建EXCEL工作簿- B! ]7 G9 }' O$ s7 p) r- e
- For I = 0 To T.Rows - 1 '从CAD表格中逐单元格向EXCEL中复制0 R# \3 R; b- }3 w5 l" W) b# I
- For J = 0 To T.Columns - 11 ~/ T/ g! R+ y8 X9 J
- B.Sheets(1).Cells(I + 1, J + 1).Value = T.GetText(I, J)
6 Q& v e3 f2 _7 g/ u - Next
, |0 _# ]/ @2 x/ a) W9 L3 X' @ - Next8 ]8 j/ K* _! H% E9 m- G6 }/ V
- End If C# M! A1 z- L' m
- SS.Delete '删除用过的选择集+ N8 V1 b6 ^7 h* I3 p# m
- End With+ O2 `# s# c" H/ U7 ~
- End Sub
8 ]. P! Z- W* p. t- G
|
|
发表于 2009-11-13 09:57:39
:victory: