|
|
Sub list() 1 z; m- a* v, ]8 Z- o
Dim work As Workspace # M0 L o/ A5 u+ ^
Dim new As Database % J# O/ i* `, F0 j0 o- K" `
Dim elem As Object
0 {8 o! T) t7 u8 ~* k" jDim rs As Recordset 3 p. m+ t+ n* m+ Z3 |! }! B
Dim RowNum As Integer
3 z( `5 C3 E, C& P& [1 E( gSet work = DBEngine.Workspaces(0)
" K$ M2 L" q) e3 V) bDim dbs As Database 5 v; o3 J% } V3 {6 Y
Dim tdfNew As TableDef # f! r- m r4 s
Dim tdf As TableDef " U# B2 n* i; F& z. Q" j
Dim dbsname As String
0 [& b h9 x5 | ~" M1 X! oDim array1 As Variant ( w$ `9 Y3 O, S
Dim array2 As Variant ‘声明所需的变量及类型 9 g$ l& Q+ t) U( L4 ] U& P
dbsname = “D:\材料表.mdb” 5 r5 @) d3 H5 D
‘声明Access数据库写到哪一个文件 3 f, u+ j! s3 b+ y f7 n
On Error Resume Next , r" V+ {+ ~/ l; f" v6 Y9 [8 J
Set dbs = work.CreateDatabase(dbsname, _
7 N) l0 ^; G8 ?* ~2 ?) P( |9 KdbLangGeneral)
( N0 ~5 ~, |# G7 {If Err Then
& Y- i, } I! k! @Kill (dbsname) ( C0 w" |5 _- {& ]1 P M3 }
‘发现要写入的Access数据库文件已存在就将其删除 " m( e2 ~) y" }. l; {5 s
Set dbs = work.CreateDatabase(dbsname, _ 0 D4 q* H: s/ D+ f
dbLangGeneral) & H# y- r6 R+ |
End If
5 U# G0 v+ A' M$ ~7 B5 E4 kSet tdfNew = dbs.CreateTableDef
1 v& J* @3 s2 \0 h(“电气 _材料明细表”)
% {! b9 j6 {" S+ K+ [ a‘建立一个名为电气材料明细表的表 5 l* J4 `8 C: K# y1 ?
RowNum = 0 - c& r E6 |4 B! E0 f
Dim Header As Boolean
7 M# k1 E# X/ r- p7 R& @! {7 CHeader = False : G7 m# S: a- c& I# U } n
For Each elem In ThisDrawing.ModelSpace " A$ p& k3 [' R
‘在CAD模型空间，查找所有图形对象
, ~& D3 _( ]5 o+ A3 mWith elem
9 q9 s6 v# e" d( M" Q. WIf StrComp(.EntityName,_
$ ^. g1 @; S1 N- y: U9 @2 Y* r“AcDbBlockReference”, 1) = 0 Then . W$ U3 F1 s0 Q* }
If .HasAttributes Then
. K5 o& N6 _- D+ v# N rarray1 = .GetAttributes 6 A, R2 X- J# ?6 q3 I$ P
array2 = .GetConstantAttributes 2 R. z; F, m! k0 [+ B( q; {
‘设置array1指向图形对象的属性
. y8 S# e2 p# o- R8 Z( J' @‘设置array2指向图形对象的固定属性 $ j: A! H; O! N6 Y
For Count = LBound(array2) To _ 2 p& j" Q* ]. L$ X' d
UBound(array2)
2 h- |0 U* c( ?- H* v, v9 P( MIf Header = False Then
$ k( K& x2 l' ?If StrComp(array2(Count).EntityName, _ 2 y- H4 i% ^: Y3 B: A
“AcDbAttributeDefinition”, 1) = 0 Then % l9 \0 j" `. e- ^# L
tdfNew.Fields.AppendtdfNew._ # p1 ]9 _. T2 u7 S
CreateField(array2(Count).TagString, dbText) 8 s4 ^- X, j! k0 f
End If 3 i6 Y3 Z J4 [- a$ s' y' _- R I. ]
‘读出属性值读出,作为Access数据库表的标题 / K; w. i' [7 c! }+ U4 K
End If
`3 }% g- x3 R( w, G5 DNext Count 9 B" C2 e. n5 o, m* Y
For Count = LBound(array1) To _
4 s' U$ U4 f+ D9 Q( fUBound(array1) ~5 M. s4 L# Q9 y# H" ?, ?: l
If Header = False Then
' h f1 D& c0 j1 b! nIf StrComp(array1(Count).EntityName, _ , m& w' q/ c: ], U+ [
“AcDbAttribute”, 1) = 0 Then 1 _7 s$ F( G4 E! I7 j: y# E
tdfNew.Fields.Append tdfNew. _
* f' p, p) T: V3 V2 V kCreateField(array1(Count).TagString, dbText)
E) |$ n" u; Y8 B: oEnd If
' E+ n; O6 m7 k( \1 C. U2 V9 h& ~End If
( x) i: |" b/ e# x7 o) X' {- HNext Count $ \( Q* v9 H$ _9 `1 o3 O# D& q2 R) h
If Header = False Then
4 d$ n* S) H4 T5 Gdbs.TableDefs.Append tdfNew
1 Z7 E, R% M& t, g1 R; a/ ^Set rs = dbs.OpenRecordset
( n( B6 q- f3 d8 P' l/ T(“电气材料 _明细表”, dbOpenTable) ‘打开记录
. o c# q. r& N, L5 F5 K, q r! aEnd If # U% B9 F9 G" N( B) D/ I
RowNum = RowNum + 1 . N. i c; @- r! g3 f
rs.AddNew ‘增加一笔新记录
7 S1 ^* q. x+ S7 {7 C# O# u" U- `For Count = LBound(array2) _
, o; Y6 E# k# n* l+ NTo UBound(array2)
; [2 f% c! B9 y' Brs(Count).Value = array2(Count).TextString
5 p- P4 E" E% Z* I: ?Next Count ‘读固定属性值
8 d$ L: t" N9 ^; d/ AFor Count = LBound(array1) To _ 5 K% @ P0 Z6 J
UBound(array1) ( e% F- [& b7 g: Q. \+ c+ |, S4 G
rs(UBound(array2) + Count + 1).Value = _
# c' F* t$ k6 l iarray1(Count).TextString . t, b, k2 s$ j1 M* X
Next Count ‘读输入属性值 - h# Y+ u/ u" v5 C: H) E
rs.Update ‘增加新记录修改结束
5 p) A4 I# |6 u7 x* UHeader = True 4 l! x) B4 ?. c; f
End If * c1 M8 a0 s# f$ Q, Y
End If ( n# P) M5 K6 y# h. t: S
End With
2 o R# I9 h" M2 y' S: C5 ^Next elem
8 B, |4 `* @- J5 @$ `rs. Close ‘关闭记录，释放资源
& D/ n/ e* C& ]6 u: odbs.Close ‘关闭数据库，释放资源
9 G$ O3 q4 f. ?( t& Y' w! t9 ]End Sub |
|
发表于 2008-10-17 16:08
