|
|
Sub list() . h M) X. U d1 Z. c' p) a0 \
Dim work As Workspace
" z' M3 R3 Q7 ADim new As Database
3 [* s, z* g) i w* F8 q) cDim elem As Object ; X8 E8 c/ q! v8 w+ m# A
Dim rs As Recordset z- b' ]# }9 J& X4 U. b. I
Dim RowNum As Integer
9 `7 M2 u' W( \Set work = DBEngine.Workspaces(0) 6 i9 D% @# T3 @
Dim dbs As Database # i+ b( Y6 i7 L; c, n1 O A/ C
Dim tdfNew As TableDef
8 [$ l' i8 ?: IDim tdf As TableDef
6 p2 K8 z$ m8 M/ h, m! [Dim dbsname As String 9 w9 d/ i/ }1 b, Y* `
Dim array1 As Variant
8 B& O" V$ h& sDim array2 As Variant ‘声明所需的变量及类型 4 K1 ^ x# }1 c
dbsname = “D:\材料表.mdb”
5 f) t n8 _1 N+ _' N& {‘声明Access数据库写到哪一个文件 3 `6 M# m: d4 v
On Error Resume Next
6 [/ V. N+ T( Q5 t v- bSet dbs = work.CreateDatabase(dbsname, _ ! t0 [: j& q( K# G1 b
dbLangGeneral)
" l/ E$ m- T) t" |( p& |( oIf Err Then
4 y4 _" \6 O8 g* @- bKill (dbsname) $ L: J Y. h G, N& b8 D6 R6 v2 s
‘发现要写入的Access数据库文件已存在就将其删除
) O* U) R; c6 x% u. ?& _& l ?( I7 MSet dbs = work.CreateDatabase(dbsname, _ ; }4 @7 ?0 v( U6 c
dbLangGeneral) , `8 E3 F0 \ b' p( O. J* Q* m |
End If 4 B3 u( y6 v) @# ^- ?7 h
Set tdfNew = dbs.CreateTableDef
! o. b, r. t8 C2 { r& x(“电气 _材料明细表”) ; G. b2 m8 R) r! M$ s- M
‘建立一个名为电气材料明细表的表 5 J8 _3 M% m7 m' J3 l4 i+ ?
RowNum = 0
6 f% ]/ _" F. f8 R. U7 `Dim Header As Boolean
6 Z9 G/ M) }' n. }6 ?Header = False ) H$ D8 I3 l: F) d7 E
For Each elem In ThisDrawing.ModelSpace , r( e0 Z [% J8 b* L
‘在CAD模型空间，查找所有图形对象 2 Y( u# X) F" w# X1 q% t6 I) W
With elem
6 U( F, Z8 @. ]If StrComp(.EntityName,_ ! s. O, G4 {; w% r' R
“AcDbBlockReference”, 1) = 0 Then % D5 A0 ?! a# G A
If .HasAttributes Then
% n" e. E3 p" F; v; V& [array1 = .GetAttributes
3 |/ e9 W+ V( v! D8 @9 s8 [( Y( aarray2 = .GetConstantAttributes
7 Q! A! d8 o3 n8 \/ D‘设置array1指向图形对象的属性 ' i6 c1 X9 K+ ~
‘设置array2指向图形对象的固定属性 2 W7 V6 l- @( |$ o g, [
For Count = LBound(array2) To _ T% s: i/ S7 O m R7 m
UBound(array2) " e! p% q# u9 G6 r6 ?
If Header = False Then
8 [5 Y( q! e3 ~9 ~( ?& m2 \' |If StrComp(array2(Count).EntityName, _ : Q2 z% y+ \" |8 L( ^
“AcDbAttributeDefinition”, 1) = 0 Then
% n2 h* s1 S4 gtdfNew.Fields.AppendtdfNew._
( C* [/ T# c* F6 s, {+ U9 ^CreateField(array2(Count).TagString, dbText)
' n' ~7 m$ m; T K8 c0 g bEnd If # I( j# h( E- P6 w9 A. v
‘读出属性值读出,作为Access数据库表的标题
$ f+ `6 B% J. m8 x2 v' cEnd If 2 w# m: R6 C, Z
Next Count
/ Y. h- n7 ~5 X4 G4 i+ F" }' V6 ^For Count = LBound(array1) To _
' K4 c( l6 d3 y* ^7 w @) B: J- U% m5 XUBound(array1) ) f5 r. u% J8 F) d
If Header = False Then
, z+ Z6 y& ?5 m/ IIf StrComp(array1(Count).EntityName, _
0 C V7 V& R) L1 ]“AcDbAttribute”, 1) = 0 Then
6 Z/ u' Z. x/ B B8 `2 `tdfNew.Fields.Append tdfNew. _
. {3 a! ^9 a9 Z" q/ oCreateField(array1(Count).TagString, dbText) , C8 k5 A% m8 C* y7 ]6 D
End If
# n& D( q# Y6 v3 WEnd If
' j: T* i+ `6 w, c3 [& R: p5 V* lNext Count ; k- L0 T6 Q6 |# S `& I
If Header = False Then
- m% c% d. v# z/ Z9 L. Q& Odbs.TableDefs.Append tdfNew 8 B$ Z. j$ d3 q, S# t
Set rs = dbs.OpenRecordset 3 j; [9 a& X/ Y1 k% X* u5 }
(“电气材料 _明细表”, dbOpenTable) ‘打开记录
" g% p: J6 b1 ^3 K. q/ W6 gEnd If , i0 t! v+ Q3 G1 n9 S2 G; _2 F
RowNum = RowNum + 1 . K; D1 Q# i5 x% J0 Z
rs.AddNew ‘增加一笔新记录
! \/ }- ^& M. S$ A/ ]9 eFor Count = LBound(array2) _
# V4 `8 o8 _$ W' `0 ~+ \To UBound(array2)
- P* h- Z$ ~0 g9 Hrs(Count).Value = array2(Count).TextString
; z2 @/ y1 Q! c$ FNext Count ‘读固定属性值 % e/ {2 q! ~( @: V0 x$ w% H o
For Count = LBound(array1) To _ ' Q: X& I3 ?4 d; Q4 Y8 v: A/ x x
UBound(array1)
" D& X2 }8 B4 Ors(UBound(array2) + Count + 1).Value = _ `2 F! d, t) _
array1(Count).TextString . m+ K* _% s- _/ e* e
Next Count ‘读输入属性值
8 u& ?( y) f3 m7 J1 U) t7 Frs.Update ‘增加新记录修改结束
6 X4 m* P C$ I4 b3 B, OHeader = True
- S3 r7 W% K8 ^) r, `7 b) JEnd If 1 f" e9 E6 E% j; Y4 [
End If
+ n. ]1 [5 F6 m( P% R( |End With 9 h5 w# ]; B& r' ^1 C
Next elem
5 p$ W. M0 {9 Q0 p) |rs. Close ‘关闭记录，释放资源 + S0 \# I; R! P8 r) x4 k6 h
dbs.Close ‘关闭数据库，释放资源 / a, J! b0 I! Q+ N! q1 p
End Sub |
|
发表于 2008-10-17 16:08
