|
|
Sub list()
3 k* C% F; q' ^3 EDim work As Workspace ' u, ~ @. Q% M4 S
Dim new As Database $ P) I6 D. C9 x- \6 y
Dim elem As Object
6 z/ x1 l6 w8 {/ _8 d& ^( T( {Dim rs As Recordset
# y% h% U' S. |. G4 H$ ODim RowNum As Integer
$ }: j9 l: o9 ^" DSet work = DBEngine.Workspaces(0)
. u0 _" `6 S+ Q! v+ `$ `- kDim dbs As Database
+ M4 R$ F& E$ h. dDim tdfNew As TableDef
- a% d: y, ~; K! t: e7 NDim tdf As TableDef
: w ]- Z( Z9 Q( ]2 A/ D% }0 vDim dbsname As String 1 N, \! d. g$ ]+ G
Dim array1 As Variant
6 D9 Y3 W" ?; l' h: ?% [0 N1 ~Dim array2 As Variant ‘声明所需的变量及类型 2 g/ A' f% y' o5 _+ _
dbsname = “D:\材料表.mdb”
% x+ u7 a" a# n! h‘声明Access数据库写到哪一个文件 8 l/ O. f8 w7 [' ?/ l4 c
On Error Resume Next
) j$ y% p3 I: s) z# x! z* TSet dbs = work.CreateDatabase(dbsname, _
7 W+ P) o9 u- ~2 O2 x- Z: S* A1 D3 SdbLangGeneral) - k6 w0 v/ v) j* O
If Err Then
+ B& t9 X4 C$ s0 C9 y8 `! ~Kill (dbsname)
( d) z3 O4 Z5 I& @2 Q( h‘发现要写入的Access数据库文件已存在就将其删除
. U3 f# V/ P" h+ L1 H( VSet dbs = work.CreateDatabase(dbsname, _
" g, `4 q9 T) ]2 y6 [) C; `" BdbLangGeneral) & Y% v3 b$ e0 G" Z( X* L: L
End If " z% h. z9 i! F! Q
Set tdfNew = dbs.CreateTableDef
9 w9 m, U) C; R(“电气 _材料明细表”) 8 c! B, N- V) g2 m
‘建立一个名为电气材料明细表的表
& N/ g' q. K" D1 {RowNum = 0
2 f, p* O$ P% d3 c: ]' @Dim Header As Boolean
) o# R# _2 t- JHeader = False
6 k9 A" Y: C" s% H" n. {: CFor Each elem In ThisDrawing.ModelSpace
8 M+ @) P- y1 o6 E. Z. `‘在CAD模型空间，查找所有图形对象
1 @5 D# w; C! p! [. U" g7 WWith elem / ^# t) Z B! W! q$ s
If StrComp(.EntityName,_ $ r9 C" p. r$ B: l
“AcDbBlockReference”, 1) = 0 Then
- n2 Q+ o h' \ p+ ~If .HasAttributes Then 8 z6 k P. c; n1 A( K
array1 = .GetAttributes
) s0 _1 k/ c6 L6 V' I1 p+ yarray2 = .GetConstantAttributes R( \ I' O9 {: A; m
‘设置array1指向图形对象的属性 - j' X. d/ Z" G1 I: W0 |
‘设置array2指向图形对象的固定属性
6 D7 P) s: S& _6 ?/ aFor Count = LBound(array2) To _ 6 v# }4 j- E* f! g' v1 k
UBound(array2) - T, [6 I* x M7 N; d: [
If Header = False Then / B5 U5 M$ e( l6 ]& X
If StrComp(array2(Count).EntityName, _ 6 e* d4 s6 y7 `
“AcDbAttributeDefinition”, 1) = 0 Then / t9 ~: U8 B# U+ r- ]8 v; n
tdfNew.Fields.AppendtdfNew._ 2 p- L, F- u+ u9 T- V
CreateField(array2(Count).TagString, dbText)
) y3 M- B) e- H" m+ hEnd If $ i u) T. w# o" I8 {# b
‘读出属性值读出,作为Access数据库表的标题 8 j% ~' o2 ?" s; c1 p0 F
End If
2 p3 P! J- \* SNext Count
/ p# |0 {+ x& P* R, K3 k7 rFor Count = LBound(array1) To _
8 q7 X, y/ s; w$ DUBound(array1)
7 u! \" @! P1 e& r; O9 H5 J! IIf Header = False Then 1 l) q1 i( f' S0 g* L g
If StrComp(array1(Count).EntityName, _
4 |) X: i5 Z6 u1 C“AcDbAttribute”, 1) = 0 Then : h' z3 L, y# H7 g9 W
tdfNew.Fields.Append tdfNew. _ 9 n" n3 ~' c# A7 F+ D$ m$ p# T
CreateField(array1(Count).TagString, dbText)
* L! }. N+ K4 Q- XEnd If 5 ^( S3 o2 G" x) S- k; y' p8 z
End If 5 D3 Q/ M, a7 A: a( q' Q9 z7 ^
Next Count
. F6 U1 D. F/ o i% R2 qIf Header = False Then
3 U% n! A& |& Z0 F( l) R7 zdbs.TableDefs.Append tdfNew 9 @: M) t( u* J$ y, q$ p! w
Set rs = dbs.OpenRecordset
; b- I% o, g- @(“电气材料 _明细表”, dbOpenTable) ‘打开记录 i6 `, X. u, ]
End If
& V8 E% a* l# |% |8 {. |! K: FRowNum = RowNum + 1
8 Z# ~* k1 ~* L" a7 y5 V# w, d+ }rs.AddNew ‘增加一笔新记录 & [% k& p# I/ w
For Count = LBound(array2) _ / o Y- | V) X( Z( n
To UBound(array2)
9 {8 r; n1 o& K/ b" v8 k: M( nrs(Count).Value = array2(Count).TextString & T1 @* s; f* h8 O6 H4 X. Z
Next Count ‘读固定属性值
5 l$ @. {9 `6 z$ g6 ?, hFor Count = LBound(array1) To _
/ S1 `2 {2 Q# [( pUBound(array1)
' G2 s9 \+ G; r7 ~0 i- m8 ^rs(UBound(array2) + Count + 1).Value = _
# b' D; t7 P; r- ?6 X) x5 yarray1(Count).TextString
; e0 P7 j2 `7 ]9 NNext Count ‘读输入属性值
' t9 i( C9 e8 A: D+ | ors.Update ‘增加新记录修改结束
( E L! `6 w) o; {Header = True
5 b( P- K5 F& I0 g5 P- \% OEnd If
! {" T/ A4 |0 IEnd If 4 i! S; R2 M, N9 ^( q
End With 8 Q8 N } {" t1 v8 g* K
Next elem 7 s( }2 _* \$ J: \5 ~2 Z: X
rs. Close ‘关闭记录，释放资源 + D4 h. h0 V+ e; O
dbs.Close ‘关闭数据库，释放资源 $ h9 S( l# K! [. I3 l9 {9 V& t
End Sub |
|
发表于 2008-10-17 16:08
