|
|
Sub list() . D! l% L4 Y9 B
Dim work As Workspace + f5 e+ X7 e$ l5 ]1 T
Dim new As Database # A$ ]+ H3 Z7 ^* u# |
Dim elem As Object / J6 c: m- E6 U1 P( e' ~+ z( j. _
Dim rs As Recordset % L" s! i5 w$ w( x
Dim RowNum As Integer
8 g( Y$ q- K+ U% ?7 p: z4 qSet work = DBEngine.Workspaces(0) . R7 E0 M+ z0 W5 _# |, i( |
Dim dbs As Database
0 V! i. c$ b% M0 M' x: eDim tdfNew As TableDef
* @5 F3 O Q9 MDim tdf As TableDef
% r! w9 }, m/ bDim dbsname As String
' J6 L# Z, `2 s4 n. Z& q0 eDim array1 As Variant
, `: M" P- M' I/ c7 o" D* NDim array2 As Variant ‘声明所需的变量及类型 ! n1 Z. y8 L+ o
dbsname = “D:\材料表.mdb”
: q" s/ |5 g" K: k. P0 Z‘声明Access数据库写到哪一个文件 ) t5 @$ b% y9 [) Z
On Error Resume Next $ m9 C6 Y" m% w7 q7 c, M* c
Set dbs = work.CreateDatabase(dbsname, _
8 y1 K6 }- [3 @% j- t4 M- ~4 w' MdbLangGeneral)
7 e6 L6 F# e( P. s1 h% DIf Err Then . o( c5 t% f- l; u. Q* Y
Kill (dbsname) . x. W' S" M# g# |* A6 G' c
‘发现要写入的Access数据库文件已存在就将其删除
( H* o+ l& _$ n; q$ b" h1 CSet dbs = work.CreateDatabase(dbsname, _
$ W( c4 Z/ n: r _' W, H# q$ UdbLangGeneral) : }" [3 F. P8 L. L3 `
End If " s6 x1 t: C% ?& ]4 ~% a1 X! b
Set tdfNew = dbs.CreateTableDef
; R3 ^; F/ N) R" ~. S2 Z2 H(“电气 _材料明细表”)
+ s' ]# P" t7 p4 D! j‘建立一个名为电气材料明细表的表
3 ?! x! n; `$ V* J3 s% URowNum = 0 9 s# v1 a# K6 O9 {
Dim Header As Boolean 3 d" ?. X) y4 i5 _6 h+ z( }2 D+ h
Header = False 6 Z1 G R- B6 A6 Q1 _
For Each elem In ThisDrawing.ModelSpace
/ K; {& D0 ]) G4 c( t! @7 u6 G' E‘在CAD模型空间，查找所有图形对象
% A1 Q4 `# f+ q r' ?6 gWith elem
% N& o( V; E7 }2 d4 t) K: WIf StrComp(.EntityName,_ 8 V6 W' V- S \' E0 G/ o
“AcDbBlockReference”, 1) = 0 Then
9 ~! ^: W) X+ f# I+ M3 hIf .HasAttributes Then
# d! O' h; B1 W( G; Jarray1 = .GetAttributes ( I" `! x. l: h; V) O. G
array2 = .GetConstantAttributes
& d2 E, |# S$ I* r‘设置array1指向图形对象的属性
/ @! ^, S6 K! F$ m( Q8 c. A‘设置array2指向图形对象的固定属性 ; Y: v1 J9 E& ~' s) y5 k# H
For Count = LBound(array2) To _
4 I, @: `/ f' E4 F; cUBound(array2)
7 |. O/ P8 o$ n6 M, h. z5 J) _If Header = False Then 1 b- _& O6 C* E" T/ ^* A! K- v
If StrComp(array2(Count).EntityName, _
' K! b. g, Q( K; K“AcDbAttributeDefinition”, 1) = 0 Then . Q% G1 P, `; ]0 i% Z' F& O
tdfNew.Fields.AppendtdfNew._
# {0 P" H1 H' JCreateField(array2(Count).TagString, dbText)
4 F" v# i& p) \# N! }; M2 OEnd If * j, b- M5 s6 D3 B
‘读出属性值读出,作为Access数据库表的标题 & A6 j0 n1 m7 s7 N+ q3 F9 r: h0 n O
End If
* r+ H1 F# J2 e5 @Next Count
; r \4 G' t* y0 Z% ?6 M- {For Count = LBound(array1) To _ " t2 w" [& E, f* P
UBound(array1) K$ F3 ^6 A$ ^. W& i; q5 z
If Header = False Then
4 w4 j% ?9 U8 S9 K0 T6 ]- q [If StrComp(array1(Count).EntityName, _
' P5 B7 i- H' U“AcDbAttribute”, 1) = 0 Then & f- J4 u1 M/ `* t3 A
tdfNew.Fields.Append tdfNew. _
7 E1 Q4 M* Q0 t3 ?) Q, J2 j7 }CreateField(array1(Count).TagString, dbText)
0 E5 I4 z" E4 e: TEnd If
5 p+ R& W2 [; E* PEnd If
5 Z* s: a; n7 o, }- ]Next Count
, _+ B, l8 |. B' z% b! gIf Header = False Then
8 K' _$ ~: h: Q7 E) tdbs.TableDefs.Append tdfNew 5 r0 { G% `! c4 ^: q! J
Set rs = dbs.OpenRecordset
) E0 w! |) B: Z* a) G3 _(“电气材料 _明细表”, dbOpenTable) ‘打开记录 2 Y. w" { S! W
End If
" K% t# Y$ {! z8 r, h1 ]RowNum = RowNum + 1 " O) Q$ W; W2 N* D% \. r$ d
rs.AddNew ‘增加一笔新记录
4 z( ~$ v9 [' J( FFor Count = LBound(array2) _ 8 d3 D% G* O3 ^: g( s1 i7 W
To UBound(array2)
- r& T, A& I4 U1 H5 {rs(Count).Value = array2(Count).TextString
I& a: o% F; y. u' u. Q2 v: E% \Next Count ‘读固定属性值 0 W& l$ ` [: ^9 w. k/ R5 E
For Count = LBound(array1) To _
* i: a* r% a% {0 K% ZUBound(array1) " U1 W( b5 R" g" U; K* H
rs(UBound(array2) + Count + 1).Value = _
* `3 |+ g ~# D X9 s2 Earray1(Count).TextString * U9 a8 h; T# ~. [ E6 B- T
Next Count ‘读输入属性值
' r7 v0 I" b* a# T& X) d& N* Ars.Update ‘增加新记录修改结束 6 { L. k" j0 _* L7 m! [# s
Header = True 9 x" ~9 v& Q$ C. e1 @6 `+ E
End If 5 z" J" t7 K" R; r
End If ) f0 @" ~) K; l( Y
End With
u! M6 g* l* @Next elem
7 p$ @/ E9 l/ u% Urs. Close ‘关闭记录，释放资源 . ^2 P' ]$ {8 e+ B* m- e
dbs.Close ‘关闭数据库，释放资源 ; i# L7 g, K4 Y- S) Q' R
End Sub |
|
发表于 2008-10-17 16:08
