|
|
发表于 2009-11-14 08:21:05
|
显示全部楼层
来自： 中国
使用下面代码前,必须先在VBAIDE中引用EXCEL类库- ' [ k8 D: \9 g/ l- \9 D; ~
- Sub TableToExcel()
q# C; e$ e+ {& F - Dim SS As AcadSelectionSet '声明一个选择集对象变量,用于从屏幕上选择CAD表格对象9 O9 y5 H6 F+ T/ Y
- Dim FT(0) As Integer, FD(0) As Variant '声明选择集过滤器,用于限制从屏幕上选择的对象类型, W/ u4 M' r8 i% u) a
- Dim T As AcadTable '声明一个CAD表格变量
) Z% K7 d/ e! {2 | - % v1 c. V* [4 M* V! g% b( ^6 n" ~
- FT(0) = 0 '设置选择集过滤器,限制从屏幕上选择的对象仅限于CAD表格,而不是其它对象
1 \4 [1 p" \$ S V. t# E - FD(0) = "ACAD_TABLE"
' s" S( N( X! [2 Z. J' u' S - With ThisDrawing. W; _& h# ]& y" Q: f' x8 a
- Set SS = .SelectionSets.Add("SS") '新建选择集7 P! |1 U. L6 b9 x. y. F; J, n
- On Error Resume Next
3 \1 v6 z) @: f8 M% B& [ - SS.SelectOnScreen FT, FD '从屏幕上选取CAD表格对象
7 h: H s8 E9 d' X# a2 V9 K/ ` - If Err Then Exit Sub$ a/ N5 B, h, q7 B+ I% a$ ?
- If SS.Count > 0 Then '如果有效选取了表格对象
9 W5 @* G; M; o - Set T = SS.Item(SS.Count - 1)'如果选择了多个CAD表格对象,只对最后一个进行处理1 L: w7 \2 m* f* O
- + s' y" V i2 q3 f& Z4 P6 ]+ Y
- Dim E As New Excel.Application '声明并启动一个EXCEL进程- x( S. ]1 ]$ |$ e
- Dim B As Workbook '声明一个EXCEL工作簿变量2 n0 c/ ~9 y$ ^" ~+ M
- Dim I As Long, J As Long '循环变量4 f$ N* F/ }' w
- ! j9 G) R2 ^' M M
- E.Visible = True '新启动的EXCEL进程对用户是可见的
. |% I' ] c! e4 ?" E$ E - Set B = E.Workbooks.Add '新建EXCEL工作簿
7 U/ E: `. w, A7 G5 E: ]" [5 o - For I = 0 To T.Rows - 1 '从CAD表格中逐单元格向EXCEL中复制+ ?5 H/ @* w- a; d8 u
- For J = 0 To T.Columns - 1
9 c/ P6 W: ? F3 F2 i9 q; k: o) p - B.Sheets(1).Cells(I + 1, J + 1).Value = T.GetText(I, J)
- m. n3 d- _6 |3 q6 B - Next k; I# ^+ l+ ]; V9 r/ j0 L; ?8 N
- Next
) H" O7 ^9 ?% k' T. m6 ~ - End If* x3 g& p1 U1 `1 Z( q$ P9 d
- SS.Delete '删除用过的选择集
( l/ n# l3 T# R! ?# T" D& D) [& ~& G - End With; n( G) J6 ~0 W# C% c
- End Sub8 j J, E- Z+ [. c" f: Q) O
|
|
发表于 2009-11-13 09:57:39
:victory: