|
|
Sub list()
# ]5 x5 ?9 J Z; h% D" lDim work As Workspace 4 G" x6 B$ f5 r3 [- [! H) i8 B) j, X
Dim new As Database & x6 k- } f4 |& s2 l6 |; S5 G
Dim elem As Object
8 b5 c# N/ u {. {& A. yDim rs As Recordset # d4 `# a+ H8 o) K6 A
Dim RowNum As Integer
5 a6 B# G! R# Z% l/ wSet work = DBEngine.Workspaces(0) ' b) n( y# u( f7 d! C
Dim dbs As Database - g7 H# h$ y* g9 }" i
Dim tdfNew As TableDef
5 I: V: @. J4 W/ T$ g2 u6 \Dim tdf As TableDef
& Y- {5 \& ~" z! c' dDim dbsname As String
# [5 v3 Z a8 h# d1 y4 cDim array1 As Variant
) ]; t" R7 e* K, SDim array2 As Variant ‘声明所需的变量及类型
E& K& @5 ^* H* |dbsname = “D:\材料表.mdb”
6 l6 J' p/ O8 e Z' T8 G. q0 ^- R‘声明Access数据库写到哪一个文件
3 r% H, d( v R0 AOn Error Resume Next
' H1 Y9 _' Q' PSet dbs = work.CreateDatabase(dbsname, _ 9 J; Q; B# B' m( Y O
dbLangGeneral)
3 L, J' ^( U# p* K, Y p( R( IIf Err Then 9 p7 A$ [& C8 `0 a3 k: c
Kill (dbsname) / b O1 c. I5 M: M0 K
‘发现要写入的Access数据库文件已存在就将其删除 $ m9 b- g7 H }2 }4 c5 f
Set dbs = work.CreateDatabase(dbsname, _ , d( {! o7 \, e+ J! a* C# r4 a9 O
dbLangGeneral)
. s9 ~7 T2 e# a" PEnd If
2 l5 B \6 R: r9 L: H$ D1 USet tdfNew = dbs.CreateTableDef
5 {- l# U- S. x5 G% E) K. b! B(“电气 _材料明细表”)
* f5 |2 J; J1 ?: `: [* E. q1 r‘建立一个名为电气材料明细表的表
?0 S+ A, f6 J, M: i3 \" @) A KRowNum = 0 ' O3 t* c% ]! _
Dim Header As Boolean
' V: t4 H7 [3 U9 s, c4 hHeader = False ) x4 U1 G! K3 o# }9 `# z7 Q t* P
For Each elem In ThisDrawing.ModelSpace 0 A1 j* q8 Y! x R! d) s+ Z; I: @
‘在CAD模型空间，查找所有图形对象 5 }2 M' q2 s; A7 a
With elem
& _. K" x: v! b: Q& {$ {- ]If StrComp(.EntityName,_
; q# q" p$ _# E7 O8 p“AcDbBlockReference”, 1) = 0 Then
+ q+ i4 [( q. |7 @. u: }, U7 ?If .HasAttributes Then & S3 ?/ I! r, }( i; P8 I
array1 = .GetAttributes 9 `% N) d0 r4 B) e2 J2 w2 ?; h% T% x
array2 = .GetConstantAttributes
7 J9 X7 @- U) i‘设置array1指向图形对象的属性 7 P+ }4 o5 H! D6 B& I0 N1 b
‘设置array2指向图形对象的固定属性 7 F* y* d+ \9 I& @3 ^
For Count = LBound(array2) To _
* k/ f! V/ W+ D- _- SUBound(array2) 3 q4 J5 v/ m7 u
If Header = False Then
, I2 _+ X" E1 f, c+ p: _If StrComp(array2(Count).EntityName, _
5 S: y3 O a& f, [2 `* |“AcDbAttributeDefinition”, 1) = 0 Then
, E2 G/ Q8 p) o" P9 Z% ytdfNew.Fields.AppendtdfNew._
- Z0 h$ L; R% d8 M: j: q9 o' m: f* I9 aCreateField(array2(Count).TagString, dbText) 8 N2 u/ ]. d% Q9 w
End If 4 u9 T/ d% a4 S# o0 P: q) t
‘读出属性值读出,作为Access数据库表的标题 * s: F7 z2 z' N( ?+ q. w6 Y! f9 W
End If ]4 a+ _' O, b, i
Next Count
9 z" `( F) J% R" Z2 M; }For Count = LBound(array1) To _
" N" ^0 u4 R0 [0 G9 J/ k8 w5 |) aUBound(array1)
+ U/ k' W) t9 C& @5 R' ~" E7 JIf Header = False Then n$ T; x1 y: J4 z* i
If StrComp(array1(Count).EntityName, _
$ {) c2 n* L1 n: \3 C# F“AcDbAttribute”, 1) = 0 Then
8 ~, ?4 U& C) t( n w7 V6 ktdfNew.Fields.Append tdfNew. _ $ l. a4 E6 n ] V8 W5 R
CreateField(array1(Count).TagString, dbText)
# u# `' O6 \0 _7 ~ {* oEnd If - s; S/ I: D: B; K: v
End If
& b: L% ~6 i, m$ Z vNext Count " D9 V* e& p3 T/ R( M
If Header = False Then 1 b9 |. z5 O; d: X" w
dbs.TableDefs.Append tdfNew
d4 q. r5 M$ X) b9 _Set rs = dbs.OpenRecordset
5 B; `9 g' b* q/ ]* F1 U3 {! o(“电气材料 _明细表”, dbOpenTable) ‘打开记录 1 O) N5 o3 d2 ]- K/ z
End If : |! c4 R1 h+ T% m; W7 C2 w6 N( N, N: f
RowNum = RowNum + 1
w3 i5 K4 ?( N4 zrs.AddNew ‘增加一笔新记录 2 X/ P, b6 J6 t1 D5 H
For Count = LBound(array2) _
# q; g3 b1 q$ x0 [, l( M! @7 [To UBound(array2)
' I: L7 q; S# I2 ?+ e* ]rs(Count).Value = array2(Count).TextString
% M3 [" M* l2 \* N, CNext Count ‘读固定属性值
+ e9 w1 h1 D; o* Z1 ?For Count = LBound(array1) To _ # U$ t, J2 r8 @ J# \4 V ]
UBound(array1) + e) J+ e* X$ B# H" O, F
rs(UBound(array2) + Count + 1).Value = _ 1 B% Y; J |. ^; F( l4 |
array1(Count).TextString 2 H1 Y" ?1 f! ^2 k' E( H/ R* q' i; L( m
Next Count ‘读输入属性值
1 H( a& w i r4 d/ krs.Update ‘增加新记录修改结束
" p; K) P+ ^, UHeader = True * H, u' Z6 |/ f; r
End If 7 l; C* r h6 `5 ?2 ~# i
End If ' j4 i4 m: ]: r4 O, s* `( e r. R
End With & p1 Q, ~8 w# m. ~; p! X
Next elem
- Z3 @& F' j4 r1 h ]rs. Close ‘关闭记录，释放资源
# V# {/ f" i bdbs.Close ‘关闭数据库，释放资源
# K+ S t) L& d4 C( }# E/ gEnd Sub |
|
发表于 2008-10-17 16:08
