|
|
Sub list() / H( G) n1 Y! y$ D2 y' `; D: ?/ y
Dim work As Workspace
3 n5 [9 V- u% v3 Y3 @5 y4 {7 cDim new As Database
/ h8 y5 f3 F1 {7 N% j: u+ j/ VDim elem As Object
% w' J# ], l- ]& O0 J! JDim rs As Recordset 8 d& c1 p& t0 D: _* W; Q
Dim RowNum As Integer 1 \) `- g4 `& Z; @ @
Set work = DBEngine.Workspaces(0)
' I) }% c% E6 Y& A5 U7 @+ B; ^# @; FDim dbs As Database
; s: e" _3 T K1 _5 h9 P4 q. oDim tdfNew As TableDef 6 b0 v# c$ l& V5 H
Dim tdf As TableDef
, ^' G1 e& o9 t6 O/ m7 Z& n- g8 N( cDim dbsname As String
2 @3 k! g1 ]# [0 FDim array1 As Variant 9 L0 S" y' A. N/ F, ^
Dim array2 As Variant ‘声明所需的变量及类型 : v: [& Q1 H. P
dbsname = “D:\材料表.mdb” % D/ V4 Q* A9 G. W! @- q
‘声明Access数据库写到哪一个文件
+ W5 f, n A# f+ T1 E' R( QOn Error Resume Next
0 E' Y6 ] ?. Y' ^Set dbs = work.CreateDatabase(dbsname, _
% K' t' n# h0 xdbLangGeneral)
% r& _& S! k& ~4 G# j, w5 cIf Err Then 3 m' ?4 ~6 {" i( h5 r) |
Kill (dbsname) 8 t5 ]# }) U* ]# t8 @
‘发现要写入的Access数据库文件已存在就将其删除 $ `+ ~& q4 K1 u! {2 Y+ u' o
Set dbs = work.CreateDatabase(dbsname, _
+ P# ?' y& g4 ~- A( qdbLangGeneral)
( R8 R' D n+ A; eEnd If
5 s9 }" i+ w4 h/ ^' bSet tdfNew = dbs.CreateTableDef
6 _) k' u4 w/ k3 m: c5 l h(“电气 _材料明细表”)
0 K) ]- ^& d+ M4 f9 `6 T" w‘建立一个名为电气材料明细表的表 ; C% t" d- G: D( x* A
RowNum = 0
: ~. E* t" O$ c/ aDim Header As Boolean
9 z( G2 k1 b: E; w: T4 ]8 oHeader = False 9 x/ H9 t$ |! `6 H5 z
For Each elem In ThisDrawing.ModelSpace * r2 x! {/ _' `& D ~
‘在CAD模型空间，查找所有图形对象
0 k- D! [0 Y. l3 O( v) z; ]With elem
2 w; {& }/ R) Z7 ^( nIf StrComp(.EntityName,_ 6 n6 o; S! R3 ^4 K: Z
“AcDbBlockReference”, 1) = 0 Then
0 B. P. W( |* l$ o& g. l5 ~- QIf .HasAttributes Then ( e8 L9 u9 G* p2 b5 {: t
array1 = .GetAttributes
& R. J5 w+ |/ [array2 = .GetConstantAttributes 1 V. T; f$ l% L
‘设置array1指向图形对象的属性
8 o/ j. d: f7 b% \! y7 f: [$ m& `) [‘设置array2指向图形对象的固定属性
3 Z* v* f% E! {2 \For Count = LBound(array2) To _
" s( O5 l0 [( u% V& D+ J1 yUBound(array2) 1 A0 R+ j! c% M0 k, J+ }
If Header = False Then
0 s6 Y" `1 a: X& e' E3 u* h' RIf StrComp(array2(Count).EntityName, _ ; ]% y& C1 G' { c/ l5 s
“AcDbAttributeDefinition”, 1) = 0 Then
4 o/ l4 I" n# _/ v) G4 ptdfNew.Fields.AppendtdfNew._
- J- c2 f* U3 W/ SCreateField(array2(Count).TagString, dbText)
' j {. d, @. T: s# g8 fEnd If
0 i! {' ~- Z. ?‘读出属性值读出,作为Access数据库表的标题 C3 r+ Q6 G9 T/ ]' E2 l; |
End If
2 S5 E5 E8 } L5 c. o! z) c& iNext Count 5 f, V( g0 m1 ^) K& F
For Count = LBound(array1) To _
& e8 F9 Y# n6 Z8 l/ fUBound(array1)
0 }' W9 n# D( I; iIf Header = False Then
# C# k2 M& Z7 I8 U( U- J% cIf StrComp(array1(Count).EntityName, _
% }. W* @: x2 a5 x“AcDbAttribute”, 1) = 0 Then 7 w. r" ~5 ]7 P
tdfNew.Fields.Append tdfNew. _ ; H, I4 `/ I+ S1 k
CreateField(array1(Count).TagString, dbText)
! Q8 V/ U+ L# n0 t9 f. OEnd If ) _0 o4 l! h4 H% h" M
End If
, t3 T, {$ z2 e; n8 `& NNext Count
& P2 \* v8 u; {, _If Header = False Then
; }" E; ?1 \6 Y0 ^dbs.TableDefs.Append tdfNew 3 E8 p6 e5 Z2 u) S
Set rs = dbs.OpenRecordset ( n4 _* h/ O( S6 Z
(“电气材料 _明细表”, dbOpenTable) ‘打开记录 i/ Z9 V6 S$ v4 A6 W2 j! w. m
End If 3 i; L0 b& T2 B9 j0 @
RowNum = RowNum + 1
7 k; E1 E4 t- f6 k8 rrs.AddNew ‘增加一笔新记录
- u: F0 h, f! E) T$ ~For Count = LBound(array2) _ 1 }, W% ?: ~- q$ } `. V& W, g/ {. E
To UBound(array2)
3 G, F' Q% p- ^3 e, Srs(Count).Value = array2(Count).TextString
7 s/ G4 z2 n( U( h& S. {, ]Next Count ‘读固定属性值 4 d- f% D1 ~ A: ?- N N& ]9 g
For Count = LBound(array1) To _
' S- A( w$ F$ X# L/ B( z E. y8 VUBound(array1) % z! p4 u/ B( n- s+ U
rs(UBound(array2) + Count + 1).Value = _
; D/ c. E7 a7 _5 f1 k. barray1(Count).TextString $ N* ]. Y; v* h4 c$ _3 V
Next Count ‘读输入属性值
3 Z- M6 o5 G0 O, @rs.Update ‘增加新记录修改结束 - J& u5 O! W* I( L4 |! j
Header = True , k q M0 M1 l, a/ @2 T- ~ ?
End If / a4 z1 ` ?3 a/ i. \0 l, w4 U" A0 b
End If 3 f8 Q8 i' s: `4 t
End With
3 a# @/ z# I a' W* `( U2 JNext elem b& H6 `9 E' d' t1 a! c/ Z. t
rs. Close ‘关闭记录，释放资源 , v& V9 s( ]7 V
dbs.Close ‘关闭数据库，释放资源
3 g# F* q1 I# W" [9 W$ t7 [% d% ?End Sub |
|
发表于 2008-10-17 16:08
