|
|
Sub list()
0 J1 q1 R9 O, ^% g. K- cDim work As Workspace 5 Z5 q& \ V# V3 I
Dim new As Database
, | M5 D7 I9 p7 |: JDim elem As Object 0 \! h+ G7 ~- C2 T, K$ q1 W; H2 s
Dim rs As Recordset 8 M. C. M1 R2 e( R- A6 O
Dim RowNum As Integer ! R7 E& ]( W. W% C @1 N
Set work = DBEngine.Workspaces(0) ( D' Z0 ^4 h, ]6 }7 p# a
Dim dbs As Database 3 |1 N6 B, ^+ f u) f3 O! F
Dim tdfNew As TableDef . ] O/ _8 q8 t
Dim tdf As TableDef
& e% T" E2 ~% M& T9 r, EDim dbsname As String
, U8 f# p% n6 x3 IDim array1 As Variant
) Z' P( t% d Z$ Q; RDim array2 As Variant ‘声明所需的变量及类型 6 r; l2 s7 R; s0 J- D
dbsname = “D:\材料表.mdb” ) \3 B' ^2 F7 I |+ D
‘声明Access数据库写到哪一个文件 , X- [3 H& B, n s4 ^
On Error Resume Next . R3 X* Q& \+ E3 }
Set dbs = work.CreateDatabase(dbsname, _ # n, k1 r" G- S* S/ ^& n
dbLangGeneral)
5 u2 P3 [* h8 vIf Err Then
0 ~1 D3 s$ m- a, Q+ z% @Kill (dbsname) % d2 K6 U3 H3 b" u! X
‘发现要写入的Access数据库文件已存在就将其删除 3 z2 O: K* K9 f6 d
Set dbs = work.CreateDatabase(dbsname, _
- S: K3 y4 K6 @$ L0 jdbLangGeneral) , U: D" N6 ^ F3 J) v
End If - l. H) o/ U p
Set tdfNew = dbs.CreateTableDef
; O/ {& z7 \" B! ^(“电气 _材料明细表”) 7 d$ ]1 n9 u) P5 |
‘建立一个名为电气材料明细表的表
8 ]9 x/ j- r5 D5 cRowNum = 0 $ {$ x8 ~- i, o* R
Dim Header As Boolean
; S% J1 i1 c& Y( q& |1 tHeader = False , }1 h4 a( ]8 _+ C0 K! e, ?
For Each elem In ThisDrawing.ModelSpace 0 M: X2 q5 o3 d" F! b; Y
‘在CAD模型空间，查找所有图形对象
2 Q# ?, g; `9 T( @/ eWith elem 2 Y: g& d ]) g: g$ K- u
If StrComp(.EntityName,_ 6 x% u9 t, ]+ Z: b9 x; h/ [' o
“AcDbBlockReference”, 1) = 0 Then
9 Y( v* S B% Q/ U4 Y1 KIf .HasAttributes Then * h% g6 s2 m4 Z# W
array1 = .GetAttributes
' @. N0 R+ v$ s* _+ S- Rarray2 = .GetConstantAttributes - v8 u: h9 t; ?( f, A7 @
‘设置array1指向图形对象的属性 2 P# ^2 ` L r: A2 z. V
‘设置array2指向图形对象的固定属性
/ O. R f' W# Q4 n, g7 XFor Count = LBound(array2) To _ 0 r! U) j3 Q, y
UBound(array2) * m% u5 I& D d% L# s0 A4 O
If Header = False Then : }+ ]! }$ V. T& [ v- ]0 _5 B
If StrComp(array2(Count).EntityName, _
" q Z( F+ u& w“AcDbAttributeDefinition”, 1) = 0 Then 1 v3 s; t( B3 t) b/ D0 I
tdfNew.Fields.AppendtdfNew._ $ r) _/ Z. C# m. t7 v! P
CreateField(array2(Count).TagString, dbText) 2 I3 {3 x K; U
End If
/ V5 O4 F! b3 A‘读出属性值读出,作为Access数据库表的标题 ; C& p4 y+ G/ o0 l: k- X* E
End If
# l& a* s% c" a. bNext Count 8 d( H. y8 c1 T4 c2 G8 g2 M7 s
For Count = LBound(array1) To _
' z, M- Q/ p W/ l- C7 k7 IUBound(array1)
' h6 A8 ~2 ^' _$ QIf Header = False Then
; i: O' a' y- N+ g( `If StrComp(array1(Count).EntityName, _ * _$ p0 r9 |5 z8 r7 b% j' w& ^2 S% S! I! |
“AcDbAttribute”, 1) = 0 Then " l4 U, y4 N. |8 x8 U c
tdfNew.Fields.Append tdfNew. _
! L# p# y3 c& Z) u; @" TCreateField(array1(Count).TagString, dbText)
, L) j) E9 Y3 {End If 7 X5 ^8 z6 `( Y3 a1 I
End If
8 l. Y6 j* ^. GNext Count " j+ V. c' L9 b% Q: ~
If Header = False Then
! a- D. y& n* Z/ o7 jdbs.TableDefs.Append tdfNew 5 K8 A; q) |& a% G& P& R6 x6 c+ v
Set rs = dbs.OpenRecordset 4 \- V. N, D( N, ?$ ^# m
(“电气材料 _明细表”, dbOpenTable) ‘打开记录 & D' N' {. _% h. Q
End If
7 _3 F2 N; v6 d2 _" {; fRowNum = RowNum + 1
9 u7 m# H5 k0 Y9 h% h9 f5 @3 `rs.AddNew ‘增加一笔新记录 , M \$ p: N% w' [9 s+ H2 s
For Count = LBound(array2) _ 4 d f5 u* U5 f1 [9 U
To UBound(array2) 0 q/ i4 W, h" w: a5 h, X! S2 y
rs(Count).Value = array2(Count).TextString - K8 l8 @! J! r% j
Next Count ‘读固定属性值 & D: g* t$ }2 O9 w9 E3 o" L
For Count = LBound(array1) To _ r9 ^* I- h/ N2 S* ~! R* G8 z, Y
UBound(array1)
; j& Z! ?9 ?/ `0 ^rs(UBound(array2) + Count + 1).Value = _
6 _5 s+ Y+ t6 @* darray1(Count).TextString
I+ c8 U4 M/ L. h5 R8 GNext Count ‘读输入属性值
& P- `1 V A( U/ Rrs.Update ‘增加新记录修改结束 , @; q5 h2 L. G- a1 {* k) b
Header = True 3 s, C- r& ^" g9 \; E! ]2 C& Y7 Z/ ~
End If 4 ~9 o. N, ~" j
End If
0 F& N' C3 F6 |End With - a. {% k% L+ j- }3 U
Next elem # e5 Z; J, x! u6 X _
rs. Close ‘关闭记录，释放资源
b- ]3 F: x9 w% u- x2 I5 qdbs.Close ‘关闭数据库，释放资源
% F# U/ j7 a7 S- zEnd Sub |
|
发表于 2008-10-17 16:08
