|
|
Sub list()
# X; `* B" r5 K; {: d' h S2 G" _Dim work As Workspace
6 s" E/ m( ~1 z, a8 ^1 R7 nDim new As Database ( |8 A% p% F) g: ^
Dim elem As Object
5 J4 F- T9 ?: M4 JDim rs As Recordset 8 P7 K, g1 ]. ~7 Z
Dim RowNum As Integer 5 `5 t/ X# I% z7 f& t) L
Set work = DBEngine.Workspaces(0) , F6 [3 x. B* k* o5 F
Dim dbs As Database 1 |7 H0 \# i+ J- Y
Dim tdfNew As TableDef
9 o- D* b, I3 R; K. V9 ~& U+ W! FDim tdf As TableDef
# r' i- m: o+ p9 P' O5 iDim dbsname As String " c7 y3 {7 o3 ?$ K' [
Dim array1 As Variant
! K: }1 \* W& `6 l4 `2 v" s# v& VDim array2 As Variant ‘声明所需的变量及类型 ( V" q- v, d7 W2 n8 D% y2 U
dbsname = “D:\材料表.mdb” ' R8 d7 @+ i3 g" C0 X
‘声明Access数据库写到哪一个文件
& O. b+ E. h- n0 e5 e$ Y7 ZOn Error Resume Next 0 ~; p8 @3 t1 K/ |
Set dbs = work.CreateDatabase(dbsname, _ + n$ F; H/ o# A0 c3 |
dbLangGeneral) ) @1 K+ z* g. Y2 P+ C8 E4 K
If Err Then
/ n" A7 U- Q8 m8 w' S% F7 s) BKill (dbsname) 1 Q+ U5 e" S, J* |$ x# g. Y
‘发现要写入的Access数据库文件已存在就将其删除 0 I/ M0 T* w/ Z
Set dbs = work.CreateDatabase(dbsname, _ 0 ]1 h6 ], F! d
dbLangGeneral)
* a: `- k9 @4 i* p9 vEnd If 6 v# B4 Y' o" y( ?) t7 a7 q5 l# N: H
Set tdfNew = dbs.CreateTableDef
8 p2 g& V% h, Z" g1 H& G' A(“电气 _材料明细表”)
6 D+ `) u. q ?8 ^- C) V‘建立一个名为电气材料明细表的表
% g2 Q$ E+ T. ~: x1 n9 F, RRowNum = 0
1 U& ~5 y0 }- p5 TDim Header As Boolean
# q% X! V/ y; w, n% l/ ~3 `1 b. SHeader = False {* P) ?4 i6 P. a, A6 k; J4 h. P
For Each elem In ThisDrawing.ModelSpace 2 {# X- [/ f6 G- k0 F
‘在CAD模型空间，查找所有图形对象 - [6 l) `, b+ C6 X0 a% F9 C0 ^6 u
With elem ( @( ?5 A8 W4 k% [% e
If StrComp(.EntityName,_
T4 ?% i. ^% W0 K, C2 {/ Q“AcDbBlockReference”, 1) = 0 Then
3 g4 B1 t7 p* Y, \8 yIf .HasAttributes Then * q+ y) l3 O+ I6 f' j
array1 = .GetAttributes
$ }$ N& ~8 f5 W3 }% j- y9 z- b0 L& |array2 = .GetConstantAttributes
o Z! N. s9 \2 f‘设置array1指向图形对象的属性
& P' b# y0 \) r q- Q/ _4 r‘设置array2指向图形对象的固定属性
0 ?" Q0 u) w; O$ M7 }4 EFor Count = LBound(array2) To _ 3 `2 d2 C! p8 p, f
UBound(array2) 4 f. g: }8 s4 Z2 y: U4 b
If Header = False Then * j2 q9 b' v x3 R' p
If StrComp(array2(Count).EntityName, _
' G% a# G! q! p“AcDbAttributeDefinition”, 1) = 0 Then
7 e6 L% k8 U1 O9 j8 E) JtdfNew.Fields.AppendtdfNew._
; S" G; b0 {8 u/ G. O# w8 ?CreateField(array2(Count).TagString, dbText)
8 O$ j1 O& Q4 hEnd If . q. u* C$ A2 c! q, s7 X& B
‘读出属性值读出,作为Access数据库表的标题
# A; {3 O8 G/ p/ x) ^1 QEnd If
% M0 i4 r [) e' i- B$ A7 o" FNext Count ) k. h( A% q2 _5 O8 c2 u
For Count = LBound(array1) To _
0 [8 v- b: t8 c& CUBound(array1) 3 F9 K5 w9 \; w, ~" q" v
If Header = False Then G8 [" b) d' j/ o+ f" n0 [7 c; z
If StrComp(array1(Count).EntityName, _
4 N+ [0 c- W* s3 Z: l! X: o“AcDbAttribute”, 1) = 0 Then
# r3 j* R& p8 S) U/ J5 U' YtdfNew.Fields.Append tdfNew. _
% b! q6 c. w z9 _- X1 b3 F" aCreateField(array1(Count).TagString, dbText)
8 j1 U5 i, O. B- I. _# b0 n2 S( pEnd If " {$ V2 H5 z3 Y! L) y1 Z' B: D' c
End If 3 A! q c; }8 `7 Q: J+ e
Next Count
- A5 V9 t; m; Q% n* A+ ^! KIf Header = False Then
0 f4 Y* w6 F( ~9 B- {5 h- C: Tdbs.TableDefs.Append tdfNew 5 u I; N& h& T4 X* z- j1 W
Set rs = dbs.OpenRecordset
( O! I! g/ M% E% N% n8 V(“电气材料 _明细表”, dbOpenTable) ‘打开记录
9 e# q4 @4 u4 y$ w- d8 J+ Z+ MEnd If 5 K/ H" x E2 m' F W' k
RowNum = RowNum + 1 % ?3 }9 |$ k' `' V6 f
rs.AddNew ‘增加一笔新记录 ' c. q( S8 f- L! l2 i5 f, U
For Count = LBound(array2) _ 3 u- E G% V# v# U6 {2 B; Y9 J
To UBound(array2) # i4 J1 S, _% d
rs(Count).Value = array2(Count).TextString
* L- \3 H7 G3 \! L6 E0 B4 zNext Count ‘读固定属性值
9 c2 [. D/ } X( H* T- M* DFor Count = LBound(array1) To _ / W2 t. p9 ]9 k$ u: Z
UBound(array1) 6 {: B7 V7 t. R9 _9 R# v* h
rs(UBound(array2) + Count + 1).Value = _
- i% T6 l5 \( Z# ?# M6 j$ O2 Carray1(Count).TextString / i; V9 q) o: v% k5 {" V7 q" ?9 J
Next Count ‘读输入属性值 , ~9 X' N! x9 F! W
rs.Update ‘增加新记录修改结束 + ~9 S: V; y! I1 h4 B" G* b
Header = True
6 q) F p+ e. x( D1 `! J4 AEnd If
1 p$ h+ y( b- c" U9 J- {- m; _% X) `End If
8 X6 p7 E+ f& N* c5 K: yEnd With a2 w' N z4 [$ H: j" b$ ~
Next elem ' j/ {/ Y5 J1 O) y3 V7 p3 D
rs. Close ‘关闭记录，释放资源 " @9 X4 N$ h+ U3 R4 _6 u
dbs.Close ‘关闭数据库，释放资源
6 O8 Y, R4 s6 B1 PEnd Sub |
|
发表于 2008-10-17 16:08
