|
|
Sub list() $ N( {/ g. A9 h
Dim work As Workspace
( O: k% J/ q! f; a6 v& ^Dim new As Database 9 Q2 W+ c$ U& w% i# `
Dim elem As Object
4 _. d$ @( d5 i2 B# ^$ p3 V% KDim rs As Recordset
# G* u& s$ K* T- [9 wDim RowNum As Integer
( U9 O% K4 D6 f7 J& hSet work = DBEngine.Workspaces(0) H1 S% K. I) L( `3 j% r% Y1 n
Dim dbs As Database 3 y8 R$ H' T; M" r
Dim tdfNew As TableDef * o% C7 R9 P+ j8 |( |! j/ }
Dim tdf As TableDef
( J* A1 m5 [+ @* J9 KDim dbsname As String
1 R( ~' p' c" q0 `Dim array1 As Variant
( j5 k5 S( ?' \! B5 nDim array2 As Variant ‘声明所需的变量及类型
( \& F) J$ U5 ]# Xdbsname = “D:\材料表.mdb” ; Z6 n) I$ f$ l! L- Q1 Y x
‘声明Access数据库写到哪一个文件 6 {" T, |5 T2 G3 y" r6 G: {8 V3 z
On Error Resume Next & h: }; u0 p1 ^0 w
Set dbs = work.CreateDatabase(dbsname, _ ! G6 u1 {) s G; H
dbLangGeneral) 9 o$ {; _8 D0 N2 `: f
If Err Then / c% ^- I$ \. q2 m
Kill (dbsname) ! x `9 c ~; ?5 o" O! I
‘发现要写入的Access数据库文件已存在就将其删除
# P* I) d8 X4 j% ^Set dbs = work.CreateDatabase(dbsname, _
# _5 ]+ O. w+ g% I' w8 U# SdbLangGeneral) - [& @& u% G+ D, a; V6 ]1 S' F. B
End If
/ j; X, Y! S- q- c4 E+ H9 rSet tdfNew = dbs.CreateTableDef
) R t4 \/ _. p6 V, q(“电气 _材料明细表”) % s m$ F/ M' w. k2 L+ Y
‘建立一个名为电气材料明细表的表
0 ], [" s* ?# R! a4 kRowNum = 0
* E7 ?+ a2 b; u1 M, d# u# b8 T; mDim Header As Boolean
/ q+ V# j! ^* @1 z% T+ I* x! zHeader = False
& X; C9 s. o7 g, vFor Each elem In ThisDrawing.ModelSpace
# K* h- i/ v3 W‘在CAD模型空间，查找所有图形对象
, ~8 A' M0 z$ m7 W r$ nWith elem
2 L+ m0 w. R# K3 MIf StrComp(.EntityName,_ 8 ^2 y9 p* R' ~! j
“AcDbBlockReference”, 1) = 0 Then
0 z* u- [9 B0 w9 y3 i. CIf .HasAttributes Then
# P$ f8 P) I" earray1 = .GetAttributes / K; i) T! C6 e' H0 f
array2 = .GetConstantAttributes + m0 m" ]5 v4 {" j1 t+ D" M7 `
‘设置array1指向图形对象的属性 $ R3 n# \$ V. r) E* H* V$ l
‘设置array2指向图形对象的固定属性
?2 n! R% K9 U* i; S3 v/ W# LFor Count = LBound(array2) To _ + C$ [ W& a5 h- a, L* p
UBound(array2) 9 ~7 ?0 a! Q u9 K- V, s8 D6 X
If Header = False Then ' a2 G; \7 T; ~
If StrComp(array2(Count).EntityName, _
& W& m0 n8 d+ \- e1 r8 @“AcDbAttributeDefinition”, 1) = 0 Then
2 I& M ?5 e4 Y+ `) ^; ntdfNew.Fields.AppendtdfNew._
6 }& \' O$ S1 f, c4 m7 YCreateField(array2(Count).TagString, dbText)
1 V9 z) ]8 y9 S5 p9 V. AEnd If
* D$ z# b; [5 H6 Y5 J7 G* q‘读出属性值读出,作为Access数据库表的标题 0 A# B6 d6 t7 u, F+ c
End If
; ?9 B. j1 Q0 F( TNext Count
- g4 }# U( I% X2 L' l$ q, u/ JFor Count = LBound(array1) To _
5 a. i% p; m6 K" R" UUBound(array1)
4 I5 f+ W6 r$ \' ^; R* B' ?If Header = False Then
( m, s: E6 f% t! d- c- p! iIf StrComp(array1(Count).EntityName, _ $ R; R: g5 V; E, {; q6 I1 \2 m
“AcDbAttribute”, 1) = 0 Then e F+ @( v" S6 ~! M
tdfNew.Fields.Append tdfNew. _
" H3 G. j6 S1 a7 J, Q3 e! f$ QCreateField(array1(Count).TagString, dbText) 6 k# t2 M1 i6 I* }7 h
End If 7 Z: J7 h, J( B3 t
End If 8 M: E7 }% X- K8 P' g% ^/ m9 P
Next Count
2 k2 j$ o7 p ?. WIf Header = False Then 9 _, N7 F8 D; Z; t: D# |
dbs.TableDefs.Append tdfNew
8 N6 g: d/ x+ b" ?% l6 J5 S( T1 v `Set rs = dbs.OpenRecordset 2 z z8 g1 A" ?( S( A+ p
(“电气材料 _明细表”, dbOpenTable) ‘打开记录 + X' b, r6 \: |* j \
End If
/ x! Y/ w2 C; `4 V2 [' ERowNum = RowNum + 1 7 b v: G/ T& k
rs.AddNew ‘增加一笔新记录
5 y" n7 O. ]) u! w8 ], z& e) PFor Count = LBound(array2) _ 3 h; d, w7 @1 A/ n; |
To UBound(array2) - `: [5 O/ g- D- C' d0 g- |
rs(Count).Value = array2(Count).TextString
; G8 K1 Q& V2 W$ I1 J6 NNext Count ‘读固定属性值 " U6 \$ L7 r1 b, H; }4 s
For Count = LBound(array1) To _ ' t! a% L0 r" ?. N- t( O) r6 s6 B
UBound(array1) 1 d, M. a' \0 q3 z5 [8 n
rs(UBound(array2) + Count + 1).Value = _
9 G$ }3 s" ~, I5 v# m7 M# n# C! |array1(Count).TextString : |2 _4 S M Z" ~
Next Count ‘读输入属性值 7 d/ {# T* i6 A8 i- i
rs.Update ‘增加新记录修改结束
, Q: v; D2 q3 e7 S$ q! PHeader = True $ p* E8 l* s M& o8 \8 L
End If
6 T `/ Q2 F# bEnd If
% J: }+ P: Z' q" yEnd With
8 l3 T+ O+ W& nNext elem . Y2 A) c7 G0 k* P. |" Y0 Q6 T
rs. Close ‘关闭记录，释放资源 $ J$ [- n2 x! C- p+ F
dbs.Close ‘关闭数据库，释放资源 - u4 Y9 [8 \' q+ Y4 Z+ U6 g
End Sub |
|
发表于 2008-10-17 16:08
