|
|
Sub list() # b( J( U- ~# t; v" U; j0 }$ @
Dim work As Workspace
" g4 k0 b1 m0 {/ v- I! R; l1 fDim new As Database : o0 ?! l7 ~/ O U
Dim elem As Object
9 `* l) D1 X) [7 r! a3 \. E1 HDim rs As Recordset 7 i" D* d) V9 Z+ V
Dim RowNum As Integer
9 k2 {/ [" {7 X" j5 M& fSet work = DBEngine.Workspaces(0)
$ C" q4 d* z- v; l) B' l. DDim dbs As Database
L5 B3 Z; U5 u: f1 FDim tdfNew As TableDef
3 X9 M1 M5 w DDim tdf As TableDef
9 T' u; @( ~- M$ dDim dbsname As String
7 u" r) I2 M& I( y5 U/ p; ~% WDim array1 As Variant
& Q: t9 I9 A/ c( @: u4 {( o6 pDim array2 As Variant ‘声明所需的变量及类型 , U V9 d- l" _6 ~ r Z
dbsname = “D:\材料表.mdb”
2 \- J* A# @; \5 a, O1 M‘声明Access数据库写到哪一个文件 . U- |5 t/ l5 R8 b. |+ O
On Error Resume Next 4 d6 n- m, w% K3 }, z
Set dbs = work.CreateDatabase(dbsname, _ 3 W6 O: d" c1 B+ c6 M0 x
dbLangGeneral)
" F& Z$ B* c9 m6 x( ? q8 e$ j: [If Err Then ; t5 V3 b6 g, U$ y7 c0 w
Kill (dbsname) ! f' U; X4 s `0 r& H. g U
‘发现要写入的Access数据库文件已存在就将其删除 3 f: D- U7 R+ m# d4 X
Set dbs = work.CreateDatabase(dbsname, _ * ?) G% a. o! f4 g. v. u0 i
dbLangGeneral)
& I! B2 n) g6 y& B) D; \End If - w% H Y1 p' ]: d8 h& }; a r& m
Set tdfNew = dbs.CreateTableDef
2 o/ P4 b! _5 E" P; ^% e(“电气 _材料明细表”) ' O/ b; I; v6 Q: _0 w
‘建立一个名为电气材料明细表的表
% E; n! L5 W1 B4 j6 p8 uRowNum = 0
0 l5 p$ z h1 MDim Header As Boolean ; D1 H5 R5 Y# h* Y/ h8 \3 G( d( @
Header = False
% l+ F3 k! P1 J* X# f- I; l q* qFor Each elem In ThisDrawing.ModelSpace
( d1 W: d4 S4 H‘在CAD模型空间，查找所有图形对象
) Z9 P) M6 n, Q' yWith elem
9 A1 ?1 B# V9 R$ B ?0 ^' q: zIf StrComp(.EntityName,_
* l! A* P! a# x3 M. ]0 w“AcDbBlockReference”, 1) = 0 Then
. D O- q) L- T" U0 y$ C- EIf .HasAttributes Then
2 _# {) S4 G" {. m$ e" W. L- jarray1 = .GetAttributes
/ ]3 a$ r2 h; b- warray2 = .GetConstantAttributes $ M. t0 w8 F" X8 F- p( d8 h
‘设置array1指向图形对象的属性 & s$ E# T3 H/ c8 @0 |3 j% p0 p
‘设置array2指向图形对象的固定属性 }: b6 N) y9 `" L3 |) d
For Count = LBound(array2) To _
& Z1 S: i9 s8 v* G+ bUBound(array2) , w& L$ g4 M; C Q& Z, T3 w+ n# | b$ a
If Header = False Then * @5 ?% }6 c* l" Q
If StrComp(array2(Count).EntityName, _
& A# [" W3 a+ a$ k9 A5 c“AcDbAttributeDefinition”, 1) = 0 Then ; v$ ~) H2 n$ f4 Z2 V4 c# x; r+ T
tdfNew.Fields.AppendtdfNew._
' |( o" Z1 ^+ A; F$ R% a5 HCreateField(array2(Count).TagString, dbText)
4 I: A/ m0 x1 ~0 E3 KEnd If 0 K( s4 }6 m5 D+ i; {
‘读出属性值读出,作为Access数据库表的标题 + t& `' j1 b% D: {" K8 ]( r7 g
End If
; E0 V) {& t, mNext Count 4 ]6 l- G( R+ ]" p2 T/ j
For Count = LBound(array1) To _
; e9 Q% `' ]% s3 \! }UBound(array1) ' [* ~4 |& W' {
If Header = False Then * I2 _! A* X! L+ O5 h5 {0 e4 x
If StrComp(array1(Count).EntityName, _ ' g6 i$ f# U1 ]0 u. e& L: ~
“AcDbAttribute”, 1) = 0 Then
" @, d7 A- n0 g8 BtdfNew.Fields.Append tdfNew. _ ! G: x' h x s$ G7 X4 E: \
CreateField(array1(Count).TagString, dbText) ; W! a7 ?' ]( i7 B+ p
End If
* y+ l+ ?/ A/ c4 s ~# \End If ( k2 d- h" J+ f3 l. ]; q" V0 n' p
Next Count P: X- R. m+ w3 t
If Header = False Then
+ p: T( U- X0 Y0 o! s! Sdbs.TableDefs.Append tdfNew
4 l: _, p/ y6 Z' r; \5 u0 ZSet rs = dbs.OpenRecordset
2 W( L) I3 C* ?(“电气材料 _明细表”, dbOpenTable) ‘打开记录
- e- X+ [, H4 F/ IEnd If
8 j5 Z- n1 r! W% C2 ARowNum = RowNum + 1
5 y& V, w/ f' l& F- Prs.AddNew ‘增加一笔新记录 6 k' g9 F; ^0 W+ H
For Count = LBound(array2) _
1 }; a8 _) i% j/ h( \( WTo UBound(array2)
- Y1 `' a, W& { o) Rrs(Count).Value = array2(Count).TextString
* u$ |7 e! p# YNext Count ‘读固定属性值 8 L( o+ u' q( g- |$ p8 |
For Count = LBound(array1) To _ 2 D0 ~ V/ u0 {1 Y* L) S) s9 o$ ?
UBound(array1)
7 x! s A7 _2 V: Xrs(UBound(array2) + Count + 1).Value = _ / c q* j0 J) D3 r6 w
array1(Count).TextString
( [7 x5 i0 ]3 `% P' x1 ?Next Count ‘读输入属性值 , z! n- k0 `; K4 f9 x- @! G
rs.Update ‘增加新记录修改结束
/ A& H0 p# F, {# R- K) D% UHeader = True
# e8 I7 I, a, }- S& n7 DEnd If ) Z/ C9 T; u& N7 X5 k2 B9 ^% M5 t
End If
1 I% }4 U4 h lEnd With
/ q& c |& u; ^1 @Next elem " l. x) u5 W$ p! l4 \8 k8 K
rs. Close ‘关闭记录，释放资源 6 T+ f5 u7 E r0 Y3 q" d6 `- S: Z
dbs.Close ‘关闭数据库，释放资源
$ y' R3 u3 p# v5 s' r2 ]& hEnd Sub |
|
发表于 2008-10-17 16:08
