|
|
Sub list()
$ X2 c# i* `$ \4 L0 ~# Y& JDim work As Workspace
) \0 N) ~& q% V7 w( P, HDim new As Database 7 \& |9 }1 S/ ?: e) p. g' f
Dim elem As Object & H. Y2 f9 ^+ V0 q; b/ P
Dim rs As Recordset 0 O+ s2 U4 J1 s( {; u
Dim RowNum As Integer ( z$ v" W3 x: d" l! v
Set work = DBEngine.Workspaces(0)
5 J) {$ P: \0 {2 ]' h& o+ WDim dbs As Database % ~5 }0 p9 T' L ^# U% w
Dim tdfNew As TableDef ' E: Q* q7 w6 u0 T
Dim tdf As TableDef
' i$ T/ m. {; C1 {) WDim dbsname As String " t. F1 c0 a6 x' I
Dim array1 As Variant - @ W# M' a2 i2 N0 M6 K
Dim array2 As Variant ‘声明所需的变量及类型 & b; X f8 m! k$ Z
dbsname = “D:\材料表.mdb”
. L6 r8 ?- ], a- c: i- @5 K8 N‘声明Access数据库写到哪一个文件 ; G$ J7 `, T! P% U9 M
On Error Resume Next
/ I1 R# @3 v, Q5 X, lSet dbs = work.CreateDatabase(dbsname, _ 3 R! q$ Z9 R2 J/ d
dbLangGeneral) 7 Q) e1 Q% ~1 P3 f" ]8 C8 ]
If Err Then 1 q5 N4 L+ A- P3 t' m
Kill (dbsname)
) c) e) F W8 Y+ w‘发现要写入的Access数据库文件已存在就将其删除 0 H( a4 ]& e) x1 t, p" ?! k$ p
Set dbs = work.CreateDatabase(dbsname, _
; `6 M' A) m% R& ~9 jdbLangGeneral) . t& f8 B' r A' r: X5 D: O
End If # d, Q5 T1 S& M
Set tdfNew = dbs.CreateTableDef
Z- E3 p) z o6 G3 D* a(“电气 _材料明细表”) 4 ]# N! H, U$ H
‘建立一个名为电气材料明细表的表
9 \! |: Z- O$ J8 TRowNum = 0
/ ]( L m3 ?/ M- F. N6 IDim Header As Boolean
. b$ f B% v2 h, W* bHeader = False ; D) f8 U* d5 s- z: b. E& i' `
For Each elem In ThisDrawing.ModelSpace ( O0 A0 W* C8 O1 w6 b: a( `* [( v' p
‘在CAD模型空间，查找所有图形对象
; ^. h: s+ K& y- Z# r& JWith elem # V9 F! b z* B7 W$ p
If StrComp(.EntityName,_ . b; u+ Q$ C7 v, w9 I
“AcDbBlockReference”, 1) = 0 Then
: a! }, _6 f' Q) }If .HasAttributes Then . h$ L2 a8 t! X0 E* e8 G* F8 c% }8 }
array1 = .GetAttributes
$ _# z; q* K; v1 r& A1 V% ]# u3 D1 b& karray2 = .GetConstantAttributes * S% i _4 I( }. D' ~
‘设置array1指向图形对象的属性 5 N f9 l; ^6 [2 Q; j% K( |
‘设置array2指向图形对象的固定属性 + \ h5 n+ z9 I h! y/ i) d
For Count = LBound(array2) To _
0 F" b7 q/ g( M" ^% S7 M- ^. eUBound(array2)
+ B- |5 @$ I. nIf Header = False Then 4 X. T' H8 Y( E% K$ L" w4 O
If StrComp(array2(Count).EntityName, _
3 w5 J4 c/ b9 V; w _$ ~. j“AcDbAttributeDefinition”, 1) = 0 Then " D8 O% c0 g' V
tdfNew.Fields.AppendtdfNew._
8 D$ {" z% S& d. R+ oCreateField(array2(Count).TagString, dbText) 1 U( I- k+ Q' m# K7 p: `( k7 K# V
End If
# J# _1 m5 r$ z, _3 z* I‘读出属性值读出,作为Access数据库表的标题 - x1 J7 \$ Q5 P$ i, V" }* s2 i
End If
, M/ p. z% |% y& A- p7 u' _Next Count
8 E/ J% n/ }6 KFor Count = LBound(array1) To _
4 \; Y$ r; {4 n+ ?" GUBound(array1) 5 I) s6 z: E, D6 c
If Header = False Then
' D, H9 P7 m1 _6 ]% kIf StrComp(array1(Count).EntityName, _ 1 i6 L& J$ P1 X
“AcDbAttribute”, 1) = 0 Then
* z$ @- v. n6 R S8 S+ b# ]tdfNew.Fields.Append tdfNew. _
0 ?$ U# R0 K" C# g% M: k+ lCreateField(array1(Count).TagString, dbText)
" J/ o. F# M9 X$ y3 n1 W \End If 7 b1 t' n7 A4 B; |
End If V$ `! `) y$ e* i' H( B
Next Count
8 |: T- W8 `' r( NIf Header = False Then , U0 h: X# N5 v0 O2 O1 ]
dbs.TableDefs.Append tdfNew / Y- ?5 K" k; j" t! U, ^ ^- Z
Set rs = dbs.OpenRecordset
+ f3 G6 I2 p- B) o4 k( K(“电气材料 _明细表”, dbOpenTable) ‘打开记录
, J+ K" D) C; OEnd If
, h* f: Z" v& _3 z, x E0 I kRowNum = RowNum + 1 ( Q0 ^4 Q# m" S" S2 l) p
rs.AddNew ‘增加一笔新记录
l5 Y- s6 S s9 v# UFor Count = LBound(array2) _ 3 q7 h [% L, l9 k+ u
To UBound(array2) + [* m3 D/ p3 p3 ~1 K4 Y2 R" w
rs(Count).Value = array2(Count).TextString
( N9 n, O- X5 \' k3 bNext Count ‘读固定属性值
% v% t4 ~* [' n5 k5 VFor Count = LBound(array1) To _
$ g s7 h- q; r$ s. [UBound(array1)
* t. f# S6 m2 r) P wrs(UBound(array2) + Count + 1).Value = _
2 g0 I9 V; d( d1 ~( O' _; rarray1(Count).TextString
: i: @( H& |2 v3 M8 ZNext Count ‘读输入属性值
. ^; @$ t8 z xrs.Update ‘增加新记录修改结束
0 ^0 g4 w3 ^- {( j) G. \& qHeader = True
, Y/ m, ?) V- \6 {; v6 p- LEnd If ( ]3 q2 b) `, c6 Z- l: A6 e
End If
' y' o& l5 D5 A' cEnd With
7 D# @3 W" ^, t* _Next elem
% y8 X$ S0 h% Q5 hrs. Close ‘关闭记录，释放资源 ! n4 }! P$ e" c4 T0 ?: t: L
dbs.Close ‘关闭数据库，释放资源 1 k5 y# R; F2 q& I6 N
End Sub |
|
发表于 2008-10-17 16:08
