|
|
Sub list() 6 ]( m6 `( a7 ?6 V4 L
Dim work As Workspace ! `3 v- Q( s7 _! V7 Z4 K1 O/ h
Dim new As Database . L" S( Q8 q! {& {
Dim elem As Object
2 n6 E9 N1 j) I% |% fDim rs As Recordset % h3 t0 z. K. P# F
Dim RowNum As Integer
8 Q) U+ r P$ z' nSet work = DBEngine.Workspaces(0)
! }9 Y( p1 K: o! lDim dbs As Database 7 j \ J9 w V$ N+ t; Q( k) I
Dim tdfNew As TableDef 4 h+ s, W4 U# D8 e7 J8 u
Dim tdf As TableDef - b4 L# j$ Z2 N7 {3 P3 z
Dim dbsname As String 8 J u7 u' e5 q' p# W
Dim array1 As Variant ( o0 m2 r- H6 Q/ t5 {8 b* K
Dim array2 As Variant ‘声明所需的变量及类型 ; Q9 ]: K6 @ h2 e
dbsname = “D:\材料表.mdb”
7 H1 u: O* l4 L8 S+ K- g' s r‘声明Access数据库写到哪一个文件 % @& ~" W9 J! |. f" Q5 C, Z0 H2 ^
On Error Resume Next
; A* a' i. j' {% }4 g! u" sSet dbs = work.CreateDatabase(dbsname, _ # ~# t a! T7 e
dbLangGeneral) , E$ M _1 Y; X) r
If Err Then
" _1 F7 E S$ d% C2 D# S8 xKill (dbsname)
( l1 |+ b. ^7 [( u2 G‘发现要写入的Access数据库文件已存在就将其删除
0 g6 E( H* P* w( E5 U a1 _+ nSet dbs = work.CreateDatabase(dbsname, _ ) y( H, {9 E& { z: G# _0 ^% J. i
dbLangGeneral)
Y' I0 z$ Z) O& E1 L- oEnd If % K3 a# @7 _$ r( F e
Set tdfNew = dbs.CreateTableDef 4 N7 q1 [- ~, v: z
(“电气 _材料明细表”)
2 s7 w& X: L' j. q‘建立一个名为电气材料明细表的表 9 F% Q# G7 |4 t7 |
RowNum = 0
+ o' L% f" I; p A* yDim Header As Boolean
. n0 Z8 s3 G& _" Z$ fHeader = False 0 {. a9 v4 W* H: Q9 T
For Each elem In ThisDrawing.ModelSpace
1 q7 W+ s7 R) p1 J5 P‘在CAD模型空间，查找所有图形对象
7 k2 K+ j! T6 c% t: YWith elem ! [4 _1 O. p7 d" ?( `6 ?
If StrComp(.EntityName,_
. y/ P& M9 ~/ z& l' k5 j) R“AcDbBlockReference”, 1) = 0 Then 1 B K4 ?$ P5 h$ f
If .HasAttributes Then
# m& w0 N* @$ B1 ^1 varray1 = .GetAttributes
H N. \( i; k8 {% K& V! h; qarray2 = .GetConstantAttributes
c! o) g5 D) ~. J5 u }‘设置array1指向图形对象的属性
) z5 z+ ?1 o% K. K‘设置array2指向图形对象的固定属性
" b( v: O+ X& wFor Count = LBound(array2) To _ 1 ~3 P; c2 b/ ^ T6 c; o% g5 n
UBound(array2) 4 W+ O* }& T7 ]4 S+ O$ e
If Header = False Then
7 i/ n! F L( Q. CIf StrComp(array2(Count).EntityName, _
% C0 x$ X$ R- L$ g" x! W5 N0 a“AcDbAttributeDefinition”, 1) = 0 Then % ?( {! F3 v% t
tdfNew.Fields.AppendtdfNew._
# y7 G. I/ b5 d- n9 f8 E% k2 bCreateField(array2(Count).TagString, dbText) $ v. D& Q4 t4 j
End If 1 W0 C; C9 O9 c% D- B) e- U
‘读出属性值读出,作为Access数据库表的标题 2 N5 D8 M, Q% w; h4 @' O
End If
- _, N( ?& ^8 @+ _Next Count 8 s% V9 ]6 G1 i/ B& s( B
For Count = LBound(array1) To _
' Q3 ~: Y) s" J, P: G9 F# \UBound(array1)
7 e* m1 C7 [; s& \3 c- D U8 jIf Header = False Then
6 m, w9 p0 V' bIf StrComp(array1(Count).EntityName, _ / x3 [9 L" k0 W5 k: V% T
“AcDbAttribute”, 1) = 0 Then
2 X: i" V# L! M j' c. D/ KtdfNew.Fields.Append tdfNew. _ ' h! U/ n2 {& I4 B
CreateField(array1(Count).TagString, dbText)
+ v$ w+ F0 @1 |2 H+ _- K5 nEnd If
. r* J' X- X& M0 c% [" {) M2 nEnd If
8 T/ n% X6 G) a5 s" t r# g/ ]Next Count
1 |' e3 W1 `; p, {1 v' SIf Header = False Then , I* n: @" S7 y7 O9 A' K- l! X
dbs.TableDefs.Append tdfNew 4 ~- R7 @& C l
Set rs = dbs.OpenRecordset 6 z1 _. J% _, E6 E7 T$ W
(“电气材料 _明细表”, dbOpenTable) ‘打开记录 ! V0 y* Y. P3 t9 a* @
End If
4 ?! \# n3 T# S$ B* pRowNum = RowNum + 1
X( [% u9 {" q5 Rrs.AddNew ‘增加一笔新记录
* v+ T, `- x: X: {For Count = LBound(array2) _
3 {4 Y4 W' g: o7 f6 oTo UBound(array2) + D! F* a4 M( L5 g4 z4 H$ S
rs(Count).Value = array2(Count).TextString
" S: E8 @5 W- Y C7 W+ aNext Count ‘读固定属性值
" w# v/ y& X1 WFor Count = LBound(array1) To _
) U `3 T) u# c: b$ _; s) oUBound(array1) ( D: g+ \8 u3 G/ t, V( G. U5 O. T0 ^8 b
rs(UBound(array2) + Count + 1).Value = _
" o+ S- v3 k) x7 karray1(Count).TextString
# n6 M6 M: m! ~Next Count ‘读输入属性值 % h0 p& x8 `' i6 j3 L
rs.Update ‘增加新记录修改结束
4 c( X7 y: o; m- k- \; VHeader = True
) r+ f3 Q+ ?) Y, W) ]End If # ~) b0 Y0 F0 ^* `1 _
End If $ ]" g/ _- m) B' f( A3 K' Z3 l
End With
Q# X, R# H' Q; c3 ?# ]/ N3 z- @Next elem
( D! b' ]$ T6 F) L( X7 Krs. Close ‘关闭记录，释放资源 / ^' ~0 U6 U8 H, D( h; [* ?# S
dbs.Close ‘关闭数据库，释放资源 % t; l( R/ S1 b; H( b p
End Sub |
|
发表于 2008-10-17 16:08
