|
|
Sub list() - q: Z% P0 |- K. S2 ]$ M
Dim work As Workspace
3 e9 K8 Q0 M9 _Dim new As Database + q- u: b2 Z# Y0 ?4 Y
Dim elem As Object 0 K2 u2 ~* }# l" D1 N. q
Dim rs As Recordset
! D8 B$ P8 g6 v; w$ z& ^$ _& j5 G7 DDim RowNum As Integer ! v" J- f; c( m2 t! W
Set work = DBEngine.Workspaces(0) $ r$ _! a8 a. T& {4 }
Dim dbs As Database 7 B2 o, w. Q9 X, s
Dim tdfNew As TableDef ' Q3 y+ p2 {7 p- p" _ A3 y! Q
Dim tdf As TableDef
( _2 `8 j% t" Q- U. mDim dbsname As String
; S3 @" L6 a* B! s# ^Dim array1 As Variant " g7 I1 x1 `. M4 q$ w
Dim array2 As Variant ‘声明所需的变量及类型
9 J7 i2 \, K3 l7 `dbsname = “D:\材料表.mdb”
4 m# Q; O* M3 ^- m. x‘声明Access数据库写到哪一个文件
2 ]; p# E: l$ Y5 g( V; OOn Error Resume Next
8 K& Y3 a' }5 f; ?Set dbs = work.CreateDatabase(dbsname, _ 7 A( P7 i1 J2 `7 X/ w3 W
dbLangGeneral) # B/ [$ @1 m- S! ~
If Err Then ; Y7 S; @3 `/ g- Z+ |; H
Kill (dbsname)
0 Z- e5 m& X" D t1 ?- X8 F‘发现要写入的Access数据库文件已存在就将其删除
; a+ U# ]0 d! O, C6 i u7 Q: _ `Set dbs = work.CreateDatabase(dbsname, _ 3 @& q4 {* r5 S2 i4 d3 ^4 W
dbLangGeneral) 8 V: }2 S7 h( }1 K
End If 1 u( ?4 u' c; i8 f
Set tdfNew = dbs.CreateTableDef
7 I z/ z6 M3 y* |: g9 z+ N(“电气 _材料明细表”) 2 p0 ^2 u* W& F! |1 @( O
‘建立一个名为电气材料明细表的表
! I" ]& g) W* c+ R; _" wRowNum = 0 0 W1 }+ b1 d3 a
Dim Header As Boolean
( A! L y( l/ M3 e- JHeader = False $ x! m! ?2 ?% p
For Each elem In ThisDrawing.ModelSpace 8 z4 J( Z& a, Y8 y
‘在CAD模型空间，查找所有图形对象 ) r& x" I8 E( m! F
With elem
8 m/ N3 W# P: q8 L! q4 o/ q; P DIf StrComp(.EntityName,_ 4 U% ]# H1 m h
“AcDbBlockReference”, 1) = 0 Then # q, v" c/ }/ L# Q1 K! q% c9 m# K
If .HasAttributes Then ( e1 l' \* |2 R
array1 = .GetAttributes
" c) G( j4 V# k0 U8 [array2 = .GetConstantAttributes ! A7 M6 m# {% f2 C, k! Z
‘设置array1指向图形对象的属性 : i% u1 F6 {3 v8 ~+ p8 T
‘设置array2指向图形对象的固定属性
) s$ u7 z- ?7 U' Z# T% B3 @9 t1 @) q$ jFor Count = LBound(array2) To _ 3 e" d! R! E* D: o/ f- T, U
UBound(array2)
8 u& O' j* { Z1 ~9 n* P. S, V% xIf Header = False Then
( J% |6 m* H' ^' j; j# J) ~If StrComp(array2(Count).EntityName, _
( f' ?5 u" Y8 p$ ^“AcDbAttributeDefinition”, 1) = 0 Then
4 P/ w6 }0 f0 K, z5 GtdfNew.Fields.AppendtdfNew._
& k+ O* ~! @; mCreateField(array2(Count).TagString, dbText) . w9 G) z" _! u1 N8 F( }" @0 i5 _
End If 1 l" l1 R4 }' D: e" i1 f
‘读出属性值读出,作为Access数据库表的标题
' X4 V# p* d: A) nEnd If , {+ y7 e5 L; Y1 p- P" V% b8 X
Next Count
" J8 d7 u, S* S& _& r! BFor Count = LBound(array1) To _ % n' S/ g, Y: \& g$ M
UBound(array1) 5 U6 _8 S% l: G5 R( _
If Header = False Then
3 m! r! e& W4 {8 k7 @+ FIf StrComp(array1(Count).EntityName, _ . @! ^5 c+ [7 G" R, g
“AcDbAttribute”, 1) = 0 Then % G1 ^+ f8 r# D7 C9 D7 O* z
tdfNew.Fields.Append tdfNew. _
3 d6 y% i" N" t$ T, C% u1 qCreateField(array1(Count).TagString, dbText) & j* z4 o7 v: f8 |! X+ z% Z
End If ; t, F. z( O! o
End If , I0 e( H# g# `7 T* f5 z
Next Count 0 P% J3 W3 s+ L; R) @! y( s$ S9 `
If Header = False Then 3 _5 k7 w9 v9 W0 w, ^
dbs.TableDefs.Append tdfNew + C, `3 e9 l; Q2 t; [" M
Set rs = dbs.OpenRecordset
5 c0 B$ x" A( U(“电气材料 _明细表”, dbOpenTable) ‘打开记录 7 a' S- S& X/ l8 R; e
End If ) S! a% u( v% \# f O* T; z
RowNum = RowNum + 1
, u8 E' ]6 e! rrs.AddNew ‘增加一笔新记录 - }/ t3 z, V2 {6 B
For Count = LBound(array2) _
& C& z! E1 e5 M) A0 |To UBound(array2)
) M' d1 [, ?8 prs(Count).Value = array2(Count).TextString
4 j3 u! V, b& h) u6 oNext Count ‘读固定属性值
/ X2 P# Z8 S/ ?$ W3 ^; mFor Count = LBound(array1) To _ 5 p7 a# Q9 y- F" ]( _
UBound(array1)
( Y$ J! L( r9 j: X* Hrs(UBound(array2) + Count + 1).Value = _ / \/ b9 V# w) e9 J3 R
array1(Count).TextString # l, z. s# z0 ~' C+ S
Next Count ‘读输入属性值 5 E2 p0 y4 }; k6 P
rs.Update ‘增加新记录修改结束 ; G: V) k, ^: l8 y& _0 r: S
Header = True 7 s% ]$ L* H, `8 P1 [
End If
% x( _1 z. L/ X3 i9 HEnd If
2 w- Z: k5 P N+ n8 g3 [End With 5 }; n; i O, P3 z
Next elem : v4 b% |. W9 ]4 `
rs. Close ‘关闭记录，释放资源
: `% `( r: i( Y; a( {dbs.Close ‘关闭数据库，释放资源 9 x$ g! d, C4 t; s2 F- ?
End Sub |
|
发表于 2008-10-17 16:08
