|
|
Sub list() 7 r( u+ T4 i5 T e& f" `! }3 i
Dim work As Workspace
x8 i( B& r- S$ y! tDim new As Database
: V0 ?! t8 P* W ?% z; oDim elem As Object - Q, X+ v5 P) o4 ?. u6 y3 x
Dim rs As Recordset 0 j* e7 P3 \9 j3 [
Dim RowNum As Integer
' b2 F) e0 X+ A$ v3 E) H% gSet work = DBEngine.Workspaces(0) ; D' [+ R( F' }% x4 N. w$ }
Dim dbs As Database
# y# ?' M( p/ z6 Q0 ^* tDim tdfNew As TableDef ( @7 \2 t, @+ K [5 z
Dim tdf As TableDef ) {7 y8 u; B2 ?2 A
Dim dbsname As String
+ o4 p% K6 X/ s/ c, g; N. JDim array1 As Variant
/ V% h0 ^0 q H! E. x1 RDim array2 As Variant ‘声明所需的变量及类型 ! u h$ X- c, U7 m% j ~
dbsname = “D:\材料表.mdb” ; Y7 B$ E' i- T9 l6 n% D% B
‘声明Access数据库写到哪一个文件
+ L/ @0 N- z- \; s% bOn Error Resume Next
) S5 |0 Z0 ]# lSet dbs = work.CreateDatabase(dbsname, _
4 U( x: v5 M- |0 b6 _, n! T) BdbLangGeneral) . e3 ~( X% |" c: j/ b* T
If Err Then
( E- Y% D0 U8 W( K$ aKill (dbsname) 9 P( \" A: H* y1 y6 h
‘发现要写入的Access数据库文件已存在就将其删除 0 ^( c. t- u1 Y3 X1 z5 {
Set dbs = work.CreateDatabase(dbsname, _ ) T4 x9 p0 ] L
dbLangGeneral) . H p9 m2 h8 g& o. u/ E
End If 9 j- N9 I: |) o. @. ?
Set tdfNew = dbs.CreateTableDef
2 {/ ?' ~& y/ m% `) a(“电气 _材料明细表”) 8 `( Q8 X1 w4 [, I
‘建立一个名为电气材料明细表的表
% L% g) O$ g) c. a; C! ~RowNum = 0 6 e/ E4 k/ P+ g0 F0 T
Dim Header As Boolean
; I! b! O3 u$ _$ Y, j) A) L0 aHeader = False 9 C' b2 C l' h" ^- I! [
For Each elem In ThisDrawing.ModelSpace
8 H5 r' G" X& U' R: s+ x‘在CAD模型空间，查找所有图形对象 ' b8 W9 r! I' Z. q; r3 }6 I
With elem
5 G/ r5 y/ x" b# w& nIf StrComp(.EntityName,_ ) o) f& f6 w! x, [6 I
“AcDbBlockReference”, 1) = 0 Then 4 N" l% \1 k5 b- ?
If .HasAttributes Then ' l' D3 u2 u E* h2 A
array1 = .GetAttributes 2 h- |+ g8 n% `8 C# C) f
array2 = .GetConstantAttributes 1 T! v( `+ X6 O; ` z* k/ f
‘设置array1指向图形对象的属性
8 j1 a! B; ]; Z. W7 B' u" H# O‘设置array2指向图形对象的固定属性
; X# @1 [+ b) t1 i6 S* O5 yFor Count = LBound(array2) To _ # w0 H$ O! S$ z# X) b" b
UBound(array2)
/ P& G' Z" d6 l! ~" V; f0 O# \1 WIf Header = False Then 6 x) x7 k2 F' R6 K1 W
If StrComp(array2(Count).EntityName, _
2 y6 ~# I" F; ?9 r! T( }“AcDbAttributeDefinition”, 1) = 0 Then 5 J# I0 ]/ S: i% G8 d
tdfNew.Fields.AppendtdfNew._
1 s6 v9 l" a# \% y) O) U, b/ q% ~) cCreateField(array2(Count).TagString, dbText) + M9 g" [% u0 y2 h3 H7 w
End If 9 A" n3 D ~2 Q q: [! t
‘读出属性值读出,作为Access数据库表的标题 2 }- Z- k+ X- k+ R" U
End If ' J7 Q' L- N+ g# ]- Z- h
Next Count / a; D- f" g( J) ]- N1 n
For Count = LBound(array1) To _
3 j# ?2 B4 u$ B% h6 m& y# NUBound(array1)
" t# j( i0 |$ }. O2 wIf Header = False Then / N' {) w$ K8 u. G; ~7 i+ w; h5 a
If StrComp(array1(Count).EntityName, _ . e. o1 B9 I) h9 F' Q3 q/ N
“AcDbAttribute”, 1) = 0 Then ! Q( j) x2 T6 x$ x" I5 ^, {$ _0 K8 F
tdfNew.Fields.Append tdfNew. _
/ c: r2 o- Y! \8 _CreateField(array1(Count).TagString, dbText) # h! b3 M l0 ]1 J. \$ Y7 D9 n
End If
/ p/ A2 U, Z* U. i8 {7 ^6 @End If 1 y( i9 R8 J5 f4 g" S5 }" ^
Next Count
+ A) n9 K2 A, w _0 t3 eIf Header = False Then 6 `# A: `. V2 K: S( @ L! t
dbs.TableDefs.Append tdfNew ( |$ v6 \* D5 c+ w
Set rs = dbs.OpenRecordset
& ]8 ~# O& q" F(“电气材料 _明细表”, dbOpenTable) ‘打开记录
. ^0 t0 l4 T; ?# r+ cEnd If - k& o6 |& P- ? f/ R
RowNum = RowNum + 1
: ? p( @0 U/ xrs.AddNew ‘增加一笔新记录 3 l }+ u2 m) S: S5 Y
For Count = LBound(array2) _
" u& v$ u5 H* c J `0 ~To UBound(array2)
9 [/ M% |9 G9 D3 i) l, w2 m$ ?! z+ F Wrs(Count).Value = array2(Count).TextString
/ f2 A6 j7 H7 ^5 P1 a8 wNext Count ‘读固定属性值
$ ?8 {9 d5 E" F) ^For Count = LBound(array1) To _ % U* m& F* N; P; `) K: o
UBound(array1) 5 L9 ^8 v& ]! y
rs(UBound(array2) + Count + 1).Value = _
4 M' M3 j' h2 w5 b' P7 }array1(Count).TextString # h/ x. l7 ]( g! b
Next Count ‘读输入属性值
% E* @6 w! J0 m% [& K9 Srs.Update ‘增加新记录修改结束
9 R- b4 h0 R7 L2 i4 ]. t5 h" D5 GHeader = True
, E1 U7 c: o" @" l/ G1 g& q- ?End If
2 V" ~0 R g) \9 o5 \6 L: p2 b; ]End If ) h' z; V: e% @8 j
End With
2 }- j5 H1 n: e6 vNext elem 4 \* ^4 D8 [& b! {. W
rs. Close ‘关闭记录，释放资源
/ K8 G0 C6 O2 _. v: `/ rdbs.Close ‘关闭数据库，释放资源 + R2 h3 m$ n2 q8 U, r( z6 `0 c
End Sub |
|
发表于 2008-10-17 16:08
