|
|
Sub list()
' n# j% o: B L& T7 @* H# MDim work As Workspace
; y5 X7 z! E& ]+ Q) e4 m" B3 GDim new As Database
8 j% ?+ r. |9 q0 x7 ]Dim elem As Object
* x7 b# C5 r; E8 \2 ^Dim rs As Recordset ) z# b S. ^: j5 P$ L) Y
Dim RowNum As Integer
( ?1 r' Y4 k5 o! z4 Y% xSet work = DBEngine.Workspaces(0)
7 o' O8 K& ~0 ^4 H. h3 _3 xDim dbs As Database
7 u, X2 y% A3 m8 l5 _Dim tdfNew As TableDef 9 ^. f+ o, X( P" ~
Dim tdf As TableDef
* _- Q- d7 c1 b0 |Dim dbsname As String
& m9 I/ e, Y- DDim array1 As Variant
% w) V. `' @0 B- s6 }Dim array2 As Variant ‘声明所需的变量及类型 : b- j( m" L$ d6 G) \0 E' D- E
dbsname = “D:\材料表.mdb” # S- z9 x$ l% ]/ j
‘声明Access数据库写到哪一个文件 6 L! E% a1 ? B8 N
On Error Resume Next ) s g6 g4 }9 c& J% S$ d4 |
Set dbs = work.CreateDatabase(dbsname, _ 3 m( C1 S2 H; b+ x0 g
dbLangGeneral)
) N& E* q# \/ z- w' W$ r( k9 JIf Err Then . Z& P; H! p. H+ c5 ~ C8 W
Kill (dbsname)
* C) k# ]# x; @3 i3 `5 z5 @6 G‘发现要写入的Access数据库文件已存在就将其删除 3 c- a& i; N: O
Set dbs = work.CreateDatabase(dbsname, _ ! h. c" _2 {$ N7 l G
dbLangGeneral) $ S& N$ w1 [& r/ t' U, i- o
End If ) y( k6 K: s% F, n' H
Set tdfNew = dbs.CreateTableDef
# o. ~4 r& }% I$ s) P. f" g8 @(“电气 _材料明细表”) ' d0 H5 t+ d2 k, m2 p$ Y
‘建立一个名为电气材料明细表的表
# P* ~9 R+ M* O( M" B1 |! z( CRowNum = 0 T z) t7 O' c* ^3 U+ }
Dim Header As Boolean
! z" o( b% k, o. n2 i- ?% |% b: G+ |Header = False / n. X* M3 f( I8 t* `
For Each elem In ThisDrawing.ModelSpace 7 _2 O/ m/ L) L
‘在CAD模型空间，查找所有图形对象 : P# T/ ~4 U* U" O& g( z9 U, H
With elem
1 ~% S/ \) g% H( qIf StrComp(.EntityName,_
6 |# A W9 h/ e+ ?9 f/ G0 i" x3 y“AcDbBlockReference”, 1) = 0 Then
& w8 R5 t9 @$ a' }" L6 s4 ]If .HasAttributes Then
7 x/ I K) y. y- Z5 Zarray1 = .GetAttributes
) Y" C4 y7 M& \9 [1 j/ tarray2 = .GetConstantAttributes ( ^% s; q M5 g+ J+ x! J& G
‘设置array1指向图形对象的属性 9 d& ?! @( Z( Y
‘设置array2指向图形对象的固定属性 0 @; B2 }/ M. H; M9 ?* h- p
For Count = LBound(array2) To _
4 ]% ^4 t3 S) J; I* sUBound(array2)
& B) c- K: K0 @9 ?+ s- ]If Header = False Then
0 [$ t. w4 J( f1 GIf StrComp(array2(Count).EntityName, _ 2 T: [ M( p# G0 ]# T% L6 v2 A% t
“AcDbAttributeDefinition”, 1) = 0 Then
: L! @" ~6 K% U0 ytdfNew.Fields.AppendtdfNew._ . R) j$ ^/ v' W( `# I* R- P- }
CreateField(array2(Count).TagString, dbText)
, {- i1 V$ C! T% f- cEnd If
4 Z7 u1 B! u& T1 u& \$ P+ Y0 h‘读出属性值读出,作为Access数据库表的标题
- @4 ^ h9 B( ^" P+ Z% GEnd If ) g3 n7 j A: V8 u; x M( G! W1 t
Next Count
8 \2 c" L9 \. e; i5 ^2 ~2 i7 jFor Count = LBound(array1) To _
- o) W$ m0 f H6 j4 dUBound(array1)
4 F$ o% P U- v/ @9 w( qIf Header = False Then
$ X0 @1 R, }$ I8 m( eIf StrComp(array1(Count).EntityName, _
8 [6 Q6 R; K2 E8 O“AcDbAttribute”, 1) = 0 Then : f4 L+ F/ e( B+ S8 N5 [4 C
tdfNew.Fields.Append tdfNew. _
/ j+ L# h2 D7 ?6 pCreateField(array1(Count).TagString, dbText) ; @% A: S$ K5 G
End If
# y1 ]( S: _& q c" U" g% Q ]End If 7 F ]* r# R, C+ N6 X) n3 C
Next Count
4 C4 u4 H! o: [, d3 |If Header = False Then
/ H: B2 N: _& O4 [; D# Edbs.TableDefs.Append tdfNew ! G8 Y7 k9 F$ d3 L% |1 k
Set rs = dbs.OpenRecordset 7 z; ^. |/ O! q2 G# R
(“电气材料 _明细表”, dbOpenTable) ‘打开记录 ! h" ^' I1 r0 M! R
End If 5 A" n+ n h- F" W3 A# y+ v+ H: m
RowNum = RowNum + 1
) I) w1 t# N3 B: f( `1 Rrs.AddNew ‘增加一笔新记录 $ ~: M4 Y. b3 T4 F% c* [/ ?( i
For Count = LBound(array2) _
" o0 u7 U9 T+ j3 W7 J! c) j1 zTo UBound(array2)
0 Q3 Z/ \! V9 G- @0 N6 prs(Count).Value = array2(Count).TextString
, ^' |/ a1 h) {: D9 I# \8 Q% pNext Count ‘读固定属性值
/ c; w4 n( ] o1 ^9 ?For Count = LBound(array1) To _
) c6 Z* [" J2 t w* NUBound(array1) ) g- l! Q4 S$ b3 Y
rs(UBound(array2) + Count + 1).Value = _ + N1 V& F2 v% c# o8 I; [: X
array1(Count).TextString
" \4 d. `8 o* h: S3 T: v, g n9 }Next Count ‘读输入属性值 $ u7 ^" W+ K! P; K' m# ~3 N
rs.Update ‘增加新记录修改结束
6 i. d' Z% Y( E1 n8 Q. x/ uHeader = True ! A# H. Z z$ i8 V8 c9 `$ _
End If
7 `, b' R) x% T4 I, A3 FEnd If
1 ^2 j+ G9 Z3 j t2 d' W+ lEnd With
8 |6 P! @( j/ ^5 L& P3 a& @Next elem
% N' V6 H# g% V" f* |# ?0 N8 urs. Close ‘关闭记录，释放资源 + c: m# C( ~+ \7 V# g
dbs.Close ‘关闭数据库，释放资源 a, I8 x$ B' U5 y
End Sub |
|
发表于 2008-10-17 16:08
