|
|
Sub list() . R2 e5 V4 |. k. m: c
Dim work As Workspace & r9 U g5 X, S; c5 Z5 M! w9 A
Dim new As Database
8 a1 L; N- K0 Q% b. _& aDim elem As Object * c w6 r$ ?3 e |3 _8 D2 n
Dim rs As Recordset % e1 M4 z) S/ ?. c; a
Dim RowNum As Integer
, v$ q, b U' U& h+ }# Y, uSet work = DBEngine.Workspaces(0)
4 [$ C. k" l: N8 L: MDim dbs As Database 5 }! ~$ z$ b; I. R
Dim tdfNew As TableDef ) V% v. x- T/ e. j+ `- f9 _: `; _2 h
Dim tdf As TableDef
, C: O1 X+ Y8 B" Y; w iDim dbsname As String 4 c' O: o( Z8 f3 y9 A/ E$ ^
Dim array1 As Variant
* a& S! t ^! Z2 V$ _Dim array2 As Variant ‘声明所需的变量及类型 4 W+ A+ t+ t. u/ N2 N: t
dbsname = “D:\材料表.mdb” ) l* y7 h7 l3 I& e" [7 j( n
‘声明Access数据库写到哪一个文件
% i! T, K. G3 w) _# O2 wOn Error Resume Next
% a# g" ^# j9 X- q5 J1 W0 SSet dbs = work.CreateDatabase(dbsname, _ $ L+ v# U6 E7 H
dbLangGeneral)
4 ^ a. e+ x2 l: K! \' tIf Err Then " s4 r% {& Q/ V5 _" b/ D
Kill (dbsname) , e* L& L$ c3 g3 x/ j2 ~
‘发现要写入的Access数据库文件已存在就将其删除
% [7 _+ Q0 k+ k6 bSet dbs = work.CreateDatabase(dbsname, _ ' Q- b/ f. k L# _1 U) l7 S$ {4 v
dbLangGeneral)
; I+ M8 R3 c* L9 TEnd If
* J7 p; c0 U$ J' ?Set tdfNew = dbs.CreateTableDef & W6 j& L- Z) U/ ?+ i* @, e
(“电气 _材料明细表”)
3 s4 Z. ]$ I, z- a% K4 o0 h‘建立一个名为电气材料明细表的表
$ v' H1 v+ v: k/ T7 ERowNum = 0 ( h+ Z; |' e5 V6 C
Dim Header As Boolean
: c* O U# r4 x1 mHeader = False
3 _+ A( L4 ?6 a }7 \ N7 XFor Each elem In ThisDrawing.ModelSpace
1 p( o& i+ p) B1 F- B1 F1 N' S‘在CAD模型空间，查找所有图形对象
* f" M, i5 ]- {; A; hWith elem
b" \8 P- P3 A) IIf StrComp(.EntityName,_ - a; | K2 s: o( {0 H+ V g" x, i
“AcDbBlockReference”, 1) = 0 Then , X* K+ d9 }& ]) {6 w: P# p: ]2 A0 q
If .HasAttributes Then
i: v' p3 _( t. u6 u3 warray1 = .GetAttributes
! w, [- u+ i7 aarray2 = .GetConstantAttributes
' ?9 X; K; ~" R‘设置array1指向图形对象的属性 $ O5 U2 C+ X( R
‘设置array2指向图形对象的固定属性
& }& U+ t' o4 ^5 FFor Count = LBound(array2) To _
' }, `0 n0 Y' K3 D/ V) i! X7 }UBound(array2)
. u _- Y" Q* k% d$ SIf Header = False Then " M. W( r& ~* R+ u
If StrComp(array2(Count).EntityName, _
. q& `5 ]5 C: J! D* U“AcDbAttributeDefinition”, 1) = 0 Then
0 i" n0 b) O. U! BtdfNew.Fields.AppendtdfNew._ & L1 T2 u% q# O/ [4 x# P8 R
CreateField(array2(Count).TagString, dbText)
% |% o/ q; t% `) ?6 V" T4 iEnd If 2 w) M- u) X8 Y9 z6 A) J
‘读出属性值读出,作为Access数据库表的标题
0 ~0 @* Y& J; _% BEnd If
" v3 t* @6 o2 hNext Count
) ?% J( e. M( x& m- gFor Count = LBound(array1) To _ 2 A+ T6 K9 i D
UBound(array1)
; q8 k' i' z$ p+ YIf Header = False Then & y8 H# \) H: @4 ]/ c: Q
If StrComp(array1(Count).EntityName, _
; V/ \6 y% h1 S# w“AcDbAttribute”, 1) = 0 Then 4 z# F- u. x/ r$ a7 ]* O5 X9 j
tdfNew.Fields.Append tdfNew. _
6 i5 x' `! N4 S/ i. L; nCreateField(array1(Count).TagString, dbText) 1 u. |5 f# d& u4 r
End If " b% ^' Y" j; r
End If : j# t2 E7 ~7 D
Next Count
4 [ [7 |; M' u6 lIf Header = False Then
8 C, b) t7 ~: u6 L7 [6 U5 xdbs.TableDefs.Append tdfNew ; Y+ p) J7 {: V5 C+ F: U- g0 Y1 D
Set rs = dbs.OpenRecordset
0 b) R* d2 p! u |* n# M(“电气材料 _明细表”, dbOpenTable) ‘打开记录
2 f# |! s R1 J+ ~1 qEnd If ( e' j7 m* P" m2 |% Y' S# O
RowNum = RowNum + 1
8 V2 E& `- r M% B( C W! jrs.AddNew ‘增加一笔新记录 : O- W5 Z/ v6 ?/ J; i
For Count = LBound(array2) _ ! O. F# b" n) g
To UBound(array2) 2 l( n) r }& }" L
rs(Count).Value = array2(Count).TextString 8 [; b- @7 j, [3 @% N
Next Count ‘读固定属性值 8 J% T# q V5 H* \$ N$ N% T
For Count = LBound(array1) To _
4 [% A8 h# U6 f: j1 K8 SUBound(array1)
- `# Q' r; O9 |, U1 p: `3 Drs(UBound(array2) + Count + 1).Value = _ 7 E. N0 ?! Q( J2 g
array1(Count).TextString
! r* G# I' v) R( @( {- Q+ B5 INext Count ‘读输入属性值 # X9 T- i+ s5 F, o/ d7 U1 P9 _- a
rs.Update ‘增加新记录修改结束 9 P2 {) c4 G! R% s
Header = True 7 } t& s+ C4 W
End If ! ]" h. a) m3 o; ^
End If
5 z7 C% G: g7 f& v) LEnd With
9 H; z+ G8 t, I8 l1 FNext elem , P* F. u* y+ v3 [. Y, `. M
rs. Close ‘关闭记录，释放资源
5 a1 E" x4 V/ J& c; @9 ~0 udbs.Close ‘关闭数据库，释放资源
9 w' z- [8 z" dEnd Sub |
|
发表于 2008-10-17 16:08
