|
|
Sub list()
$ d3 y: b& c" j1 zDim work As Workspace
& w) B+ x# s4 a8 d" W$ KDim new As Database - I8 u4 L1 R" I" [" K
Dim elem As Object
- ~4 u1 I' D/ QDim rs As Recordset
% x; |( n# N+ z$ C+ gDim RowNum As Integer . N, P. x6 j4 e( l
Set work = DBEngine.Workspaces(0)
0 k1 F2 d$ @/ }" f; B% m; }Dim dbs As Database ! i, }+ E) W" h9 f
Dim tdfNew As TableDef " P4 W# v- R/ L9 y3 F
Dim tdf As TableDef
- T1 I4 x! j2 d- R9 c3 hDim dbsname As String
: N c1 K+ b" k; R- QDim array1 As Variant
6 f& P3 a, I: ]9 x& x/ W7 RDim array2 As Variant ‘声明所需的变量及类型
8 ~4 G$ v1 d$ ^& @: x0 h3 qdbsname = “D:\材料表.mdb”
9 b1 h+ G& D3 ]6 A‘声明Access数据库写到哪一个文件
' q# _: B6 S( f# I/ yOn Error Resume Next ( [+ H" r" G, g% x2 S* U: q
Set dbs = work.CreateDatabase(dbsname, _ ! O5 s7 N5 `( U0 O7 k3 p
dbLangGeneral)
* n; D6 e+ L1 O1 i9 xIf Err Then & f" V/ _! k6 A M9 G6 w) x+ h# ~
Kill (dbsname)
# S Z8 G. b- x3 |+ Q: Q( N2 h' ^‘发现要写入的Access数据库文件已存在就将其删除
; b) P: b' M7 U3 e! D' Y* BSet dbs = work.CreateDatabase(dbsname, _
5 M$ L1 i! w' M# e# _4 V) WdbLangGeneral) 1 a' ]0 v/ x& X* `7 V$ a5 a- Y( u
End If
% z: T( H$ ~& b+ d" e. _8 V N5 M4 e7 zSet tdfNew = dbs.CreateTableDef
0 J; l/ e; {8 r. w: }3 `(“电气 _材料明细表”)
9 d2 r8 x% c* L( `- L‘建立一个名为电气材料明细表的表
$ l9 B' R) V: z9 r& ?2 qRowNum = 0
5 @" ?- Z8 _5 ?1 h" L0 WDim Header As Boolean
9 U2 Z- O4 o" gHeader = False % C# ^) H* u* d6 T
For Each elem In ThisDrawing.ModelSpace ) b+ Q' V% s4 i
‘在CAD模型空间，查找所有图形对象
/ v# p' C4 p a& O; S& ~With elem
& o% x. k- A6 f* TIf StrComp(.EntityName,_ j- A4 \' a" `5 i5 q3 S1 [
“AcDbBlockReference”, 1) = 0 Then
: \! l2 p0 g7 xIf .HasAttributes Then
, j! R8 Q0 `5 A. x( o0 d: Q# C* larray1 = .GetAttributes 6 O4 V& c* f( {3 x4 k g
array2 = .GetConstantAttributes 7 \$ ?2 i3 i/ \& k
‘设置array1指向图形对象的属性 : L4 M1 [& Z* X8 w
‘设置array2指向图形对象的固定属性 8 H" |0 K C- D! g; _1 S
For Count = LBound(array2) To _ : D$ ]; l! N: P2 e
UBound(array2)
4 g% [9 t% B* l& o$ uIf Header = False Then
+ c/ ^& I0 p0 O9 u* A5 ]If StrComp(array2(Count).EntityName, _
- n7 n$ v4 Z' _# F7 _$ O' K* O“AcDbAttributeDefinition”, 1) = 0 Then
# C' R6 E5 c, c$ z% K P: _tdfNew.Fields.AppendtdfNew._
0 z+ D9 v4 X5 Y! tCreateField(array2(Count).TagString, dbText)
5 {( l$ x5 C. Q1 n9 U9 ~) ?End If
/ P$ `" V2 G- c' O‘读出属性值读出,作为Access数据库表的标题
3 I$ u; U1 X3 A1 |4 vEnd If 6 ~" J' T v. G" N
Next Count & u& v1 B' t) H8 f1 N; ?& A6 `
For Count = LBound(array1) To _
7 R, }7 h$ B! C& ^UBound(array1)
2 W. v1 E ^1 u t, m7 jIf Header = False Then
# H& U2 b$ F+ {' _0 q1 H- ^If StrComp(array1(Count).EntityName, _ # ^9 i" u. l8 H( t! z
“AcDbAttribute”, 1) = 0 Then
6 i) w6 |( w. P' L1 l5 {0 ptdfNew.Fields.Append tdfNew. _ * I1 W3 V, [. C7 |1 m
CreateField(array1(Count).TagString, dbText)
6 j3 F3 i0 V! ]End If 8 F- G4 k6 R9 g5 a3 f
End If , `, q/ p7 _7 }. E( m8 o3 @
Next Count . B' D* ]1 [& Q n3 E
If Header = False Then
- M8 t1 D. ?( X5 zdbs.TableDefs.Append tdfNew
7 M: `: U/ V, ]1 v, ~: s3 u) V) XSet rs = dbs.OpenRecordset
* }! h* ?# k0 h! ~$ F, K% f2 f. i(“电气材料 _明细表”, dbOpenTable) ‘打开记录 ( ?& E9 }! ?, t& B' ]( o. C: B
End If 4 k) L3 i2 Q; Y. t
RowNum = RowNum + 1 & p. d e$ D, ~ v8 B( H
rs.AddNew ‘增加一笔新记录
% O' ~6 {& k. lFor Count = LBound(array2) _
, k) K/ X$ R3 QTo UBound(array2) 4 ~# _5 r/ V* J$ o. g( p
rs(Count).Value = array2(Count).TextString
. N3 h. ~! P2 y$ w' O b! E, {Next Count ‘读固定属性值
j9 L% P$ g4 w! y! J9 SFor Count = LBound(array1) To _
3 Q% U) Z7 V/ S; j4 dUBound(array1)
3 q* ~( X9 O: e4 Q, ~' Y- W( z. Ors(UBound(array2) + Count + 1).Value = _ - R8 Y. S C3 O `
array1(Count).TextString ( |! p G1 I" e/ j6 m% ]6 w
Next Count ‘读输入属性值
5 Y7 B! R& Y) y" e5 F! n4 vrs.Update ‘增加新记录修改结束 - b! ?: V0 U# u' z8 }6 X
Header = True % c) \# ]2 a+ y! ?% ^+ W5 P
End If : U1 ] L! `: V
End If % l3 O3 h$ E- s9 |/ D* H
End With $ S3 ~# C/ K, g% |
Next elem / W1 P) T8 V# \1 l" _4 N- l
rs. Close ‘关闭记录，释放资源
4 C3 E) U# E, J2 _7 edbs.Close ‘关闭数据库，释放资源
& Y: g s, i2 }8 ? n$ }End Sub |
|
发表于 2008-10-17 16:08
