|
|
Sub list() B! }# \ L3 A9 Z( g
Dim work As Workspace
1 l& K5 Z0 p0 e9 h, YDim new As Database
! T4 H4 P6 t! v# w1 W ~" b7 ZDim elem As Object
6 S% J7 ]( o" zDim rs As Recordset
8 n9 w+ d' A% S" h0 A# X7 v7 iDim RowNum As Integer / M" p) C s/ n' Y2 f- m& P4 A
Set work = DBEngine.Workspaces(0)
' N" z6 G6 Z# X( X/ jDim dbs As Database # F" g- N% N" _' t% y$ Y/ t
Dim tdfNew As TableDef 2 H9 s' r" S( O1 Z% H, g
Dim tdf As TableDef
, A% X( L9 x( u+ ^' jDim dbsname As String
& f5 i; ~1 S ~1 ?- ~( z3 ODim array1 As Variant 6 S. I: n' j. p. L7 `( P. }) H) [$ I
Dim array2 As Variant ‘声明所需的变量及类型
/ p% |! F4 v8 a6 q2 Tdbsname = “D:\材料表.mdb”
' W9 K5 H$ l6 b. K2 h! \‘声明Access数据库写到哪一个文件
2 |7 e' y% H5 t9 m8 ^" w) YOn Error Resume Next % z5 B% S. C8 c2 u- [) K/ x
Set dbs = work.CreateDatabase(dbsname, _
, J* l. _( {* \2 J. J7 G8 m, t( X. TdbLangGeneral)
$ d' H# u8 C0 E! X0 k7 v) |If Err Then
0 R+ b' c7 a6 Z- F( W, c- {4 R; ]Kill (dbsname) " o" ?1 K5 T% y% c5 e
‘发现要写入的Access数据库文件已存在就将其删除 9 l1 j# }8 B$ n3 s7 G6 n# S& l% d
Set dbs = work.CreateDatabase(dbsname, _ # w: ]9 a N3 W* n4 a, }
dbLangGeneral)
0 t0 f: A8 |- `) X, OEnd If $ _. X. ^6 e3 S, n7 y
Set tdfNew = dbs.CreateTableDef
6 X+ U: ~( E0 ?3 l0 U5 u+ T- f+ z(“电气 _材料明细表”) 2 q& T$ E1 f. @3 s/ w9 a
‘建立一个名为电气材料明细表的表 0 S9 E+ u( e, D) e; R
RowNum = 0
( k9 v; ?& u; N+ ]6 l* [1 ZDim Header As Boolean
" I4 P) n. e0 i6 J, aHeader = False
: k' Q1 r! ~6 SFor Each elem In ThisDrawing.ModelSpace 8 B( c2 {, t" Q: n
‘在CAD模型空间，查找所有图形对象
5 ^$ q( V) E+ z( V+ `With elem
- `& s5 h: k- q! BIf StrComp(.EntityName,_
, F$ ]1 y: ?( M% i6 E; r; ?# I“AcDbBlockReference”, 1) = 0 Then
$ s2 I {1 K$ F8 q ]8 O' XIf .HasAttributes Then
h! D4 O5 B7 g% x+ narray1 = .GetAttributes 6 k8 `( G! ~: z" m# ^1 Y( F8 Y! b0 s
array2 = .GetConstantAttributes ) p# \' }% g9 j" f( y8 W
‘设置array1指向图形对象的属性 * J; [) g% W/ y& W, M
‘设置array2指向图形对象的固定属性 % ?+ x+ s6 w3 k# e' z: I8 [
For Count = LBound(array2) To _
9 n! U# E% _6 K1 gUBound(array2) * w4 z; \- p# Y7 G' u9 `4 O
If Header = False Then # I) d0 O5 K' ?
If StrComp(array2(Count).EntityName, _
4 d4 b- ~- i1 L- d6 u1 k& Q“AcDbAttributeDefinition”, 1) = 0 Then
7 Y; Z! i) d" {; ]4 Y2 G; ttdfNew.Fields.AppendtdfNew._
; d1 y+ X+ z' }8 ?. |$ XCreateField(array2(Count).TagString, dbText) / Q% I4 ~" E; K/ ^& ]. M! D% T6 `- J
End If
- V; B& R( F- E1 E8 A4 x1 e‘读出属性值读出,作为Access数据库表的标题
# p5 r# j: j/ V, a* PEnd If
6 @. k" N1 \! D$ pNext Count R- j1 d9 ] A6 S/ E5 f# h
For Count = LBound(array1) To _ . G# v* C7 F" [
UBound(array1) * r7 {( y# N6 S) P' n
If Header = False Then
. C, V9 c; o- k3 S+ @* M1 PIf StrComp(array1(Count).EntityName, _
% f- W5 M$ Z y3 v6 L“AcDbAttribute”, 1) = 0 Then 4 ^/ w0 v: f- c1 l7 W) ~+ g! V
tdfNew.Fields.Append tdfNew. _
. i' ^# q7 Z+ I/ ]! A; m6 C: bCreateField(array1(Count).TagString, dbText)
* X; d2 G/ w. x0 v) ?$ w! lEnd If " }/ m F# X$ q$ a: ^
End If , T0 P2 N( G% o5 D9 g' A
Next Count ; L9 o0 u, t% Y. F: G- x' P
If Header = False Then
) O& F4 a1 k0 T2 Vdbs.TableDefs.Append tdfNew 1 W& Y* A1 H9 V1 b
Set rs = dbs.OpenRecordset 4 G2 m1 P9 u$ h# [) F
(“电气材料 _明细表”, dbOpenTable) ‘打开记录 6 n4 t* M; X" K# t" _, O
End If
" Y: T. q S3 ~' @6 n0 @& I9 @RowNum = RowNum + 1
( f, N* W Z2 M7 ~rs.AddNew ‘增加一笔新记录
" @) o- {4 z2 gFor Count = LBound(array2) _ ; u! p7 N+ X" ^2 ?% A) ~- C8 ~& N
To UBound(array2) 9 f! ?: T! X9 T }
rs(Count).Value = array2(Count).TextString
2 R, z% F% R, k( e% z- \0 }Next Count ‘读固定属性值 . H# a; F0 q: T2 a |9 G: \
For Count = LBound(array1) To _ ! {0 ?) U7 b' z G0 t: L. z
UBound(array1) : S5 M0 b! ?. V! y W$ d, u
rs(UBound(array2) + Count + 1).Value = _ & `( j) m; A* {. Q3 d! F
array1(Count).TextString
1 U6 u) b/ M( t: c* }4 B* hNext Count ‘读输入属性值
! ]1 ]% A2 `6 T6 hrs.Update ‘增加新记录修改结束
- {0 O8 a. C7 R$ X! z$ PHeader = True
r8 b, I( c% y+ nEnd If 3 `/ F' Z7 [/ B) V) ], e
End If
; v2 z" ?& H3 ?+ J. t, I& pEnd With
) I2 r7 n- _; v5 S# FNext elem / p4 J& ?2 G3 g
rs. Close ‘关闭记录，释放资源 . I/ u& ?# \1 y/ [1 ~% q) W
dbs.Close ‘关闭数据库，释放资源 $ I5 A& g7 S/ B2 `7 {5 v
End Sub |
|
发表于 2008-10-17 16:08
