|
|
Sub list() ' K: A8 U4 H+ z
Dim work As Workspace
8 T" g; Z2 }2 v" @Dim new As Database
1 E8 _' X9 s9 QDim elem As Object
0 o( L* J9 N4 t# L! Y- xDim rs As Recordset
: |$ _6 m* k3 z' R: i) f, o# fDim RowNum As Integer
' f4 p1 m# z y$ c; ISet work = DBEngine.Workspaces(0) ) q0 g6 s2 ~( e
Dim dbs As Database 3 a& K4 @( w5 L- Q' m
Dim tdfNew As TableDef
9 _2 L7 N" M6 k9 fDim tdf As TableDef
6 n, j5 r" B# ]' G, U8 kDim dbsname As String
* M' E9 h, e0 K5 ]' \Dim array1 As Variant
9 X+ |7 h# I( L3 q5 A( PDim array2 As Variant ‘声明所需的变量及类型
9 m% @+ W. K- L* o) D, M8 W1 xdbsname = “D:\材料表.mdb” $ M* _% h) u' W; Q5 } ]" t+ l
‘声明Access数据库写到哪一个文件
% ~/ y, i* [, rOn Error Resume Next
6 z7 J$ ~( Q* d3 b% dSet dbs = work.CreateDatabase(dbsname, _ ' y/ @. n. s; ]$ p3 Q. L
dbLangGeneral)
% s: C3 f. f7 x. P3 j3 ~ X6 KIf Err Then + I8 R4 p6 }$ M) F9 g _! X6 d
Kill (dbsname)
' T& P7 y" d2 W, z v‘发现要写入的Access数据库文件已存在就将其删除 ! z& }0 j" I i% q0 t6 `
Set dbs = work.CreateDatabase(dbsname, _ 0 ^ i+ X* X$ m$ {" x; M
dbLangGeneral)
1 m* O, I- ^6 E, ?. IEnd If ; v; z% [, A* a+ ]
Set tdfNew = dbs.CreateTableDef 3 W3 E' T, A4 U
(“电气 _材料明细表”)
8 V& [) r5 k: n: z‘建立一个名为电气材料明细表的表
' U2 ~' N8 K! ~( O, QRowNum = 0 / f& I# @+ r* U K8 t
Dim Header As Boolean 7 z3 h1 \/ x+ T+ B
Header = False
' r9 z' y l- r) O8 M4 n, HFor Each elem In ThisDrawing.ModelSpace
5 \ p/ R5 V8 l$ C4 F8 `7 P‘在CAD模型空间，查找所有图形对象 2 n; s8 Y* a7 x
With elem 7 r& Y8 L8 G! {; ]% m& J. a
If StrComp(.EntityName,_
9 A8 t/ |6 V+ ^5 i" A$ H- e' @“AcDbBlockReference”, 1) = 0 Then
o4 G. Z) O3 K0 R" tIf .HasAttributes Then
/ O3 A9 Z$ [$ R: T" c9 oarray1 = .GetAttributes - V- m: S: Y& I
array2 = .GetConstantAttributes
9 C; ~4 ^0 g3 l/ h2 \8 K. l6 E‘设置array1指向图形对象的属性 " Y8 q$ [6 V- ~) G3 C; C
‘设置array2指向图形对象的固定属性 , i: N* Z( @) f8 F
For Count = LBound(array2) To _
# ]3 c; K- [( {0 q0 d7 I+ r5 FUBound(array2)
' m( n6 P3 r/ n4 i" X" RIf Header = False Then 5 u7 w/ E/ z# W) s( D( B
If StrComp(array2(Count).EntityName, _ ! O6 `$ c! R4 {( D& f! e9 i
“AcDbAttributeDefinition”, 1) = 0 Then ! u/ ?1 T- O$ |( V" o _. |
tdfNew.Fields.AppendtdfNew._
, i) w" n: M* t, I$ C& f9 B; GCreateField(array2(Count).TagString, dbText)
, c/ }9 `" [) q1 |) B6 |End If
, l+ `2 K& P" K‘读出属性值读出,作为Access数据库表的标题
! s R; g6 s$ V8 gEnd If
$ ?3 p5 `% ~" E. S; |, I/ yNext Count ( X( |3 O# q- t) j% W0 e! m$ Q T
For Count = LBound(array1) To _ % \7 T* d5 D5 l
UBound(array1) . Z' |% l0 m: D4 U# \7 z5 O1 ?& C
If Header = False Then " [ v3 y+ k. W( c$ F4 o/ W
If StrComp(array1(Count).EntityName, _
$ m4 ?' }% O* `3 F! E& G" w“AcDbAttribute”, 1) = 0 Then
4 m Q A+ h# u4 e# Q+ N6 stdfNew.Fields.Append tdfNew. _ - l& ~/ M1 J' J1 o
CreateField(array1(Count).TagString, dbText)
: M# }" ^) P1 K- ~) eEnd If : m7 G3 Y; p/ S
End If - ], o8 R K1 M
Next Count
# [+ n8 C! U/ X8 m- dIf Header = False Then
9 f& X% T) A) I' |dbs.TableDefs.Append tdfNew
# Z1 x2 d8 t" q) _7 P: M! K" TSet rs = dbs.OpenRecordset
0 r- b" z9 `8 D(“电气材料 _明细表”, dbOpenTable) ‘打开记录 5 j! P9 ^7 W t1 C! d1 f
End If / Y$ E- i% S' \, f, |. ~& B
RowNum = RowNum + 1
& Q0 m" q" z5 u/ L, H; }! C- irs.AddNew ‘增加一笔新记录 $ |% y# v* o$ N+ ?
For Count = LBound(array2) _ : P4 ^7 A: z! i' R4 }/ V
To UBound(array2) ; h6 c% r; }) I8 |5 t
rs(Count).Value = array2(Count).TextString 6 X- C% l7 [# B# ?' m+ N" V
Next Count ‘读固定属性值
3 Q* P+ I$ y/ X" w$ B- W, wFor Count = LBound(array1) To _ 2 a- H0 n* U3 C$ R5 p+ ?
UBound(array1)
* Q. _! U; s) }( p. R4 A# K9 A' |rs(UBound(array2) + Count + 1).Value = _
, p$ y" U) b& S% Z$ g8 M# Z/ harray1(Count).TextString 6 K) O5 W+ c, S! I2 t+ r
Next Count ‘读输入属性值
: W: \! g& w; G2 y& w& Nrs.Update ‘增加新记录修改结束
3 y5 n3 g' N, V" e$ JHeader = True 4 `+ N5 w# ]3 b
End If
$ S7 {1 p. X/ T# j5 d5 wEnd If
8 N- D" g2 H, ^& s0 e* O4 O9 qEnd With : p# X$ z6 K2 Z- h) g5 b
Next elem
2 [6 r- u9 F- _1 i7 a6 Drs. Close ‘关闭记录，释放资源 , ~/ h0 }, E4 {
dbs.Close ‘关闭数据库，释放资源 5 n O6 G$ O! A( J/ ]7 Z# J
End Sub |
|
发表于 2008-10-17 16:08
