|
|
Sub list() - r5 ~' W& [: [; M. \- |
Dim work As Workspace : Y' ^) P }$ Y% T4 w
Dim new As Database
1 z7 t5 w4 L; r% R0 z' S* ~Dim elem As Object
6 Q( D7 n; ?: l: F% g9 h @4 rDim rs As Recordset
# m# _( x+ U H" B, ADim RowNum As Integer
. \ m8 b; H- pSet work = DBEngine.Workspaces(0) 1 m- p7 W6 J. z0 w
Dim dbs As Database
5 h$ ^8 W; c& X3 d9 S; X3 zDim tdfNew As TableDef
: h6 [" Z, u5 v; V9 j6 ?Dim tdf As TableDef 4 l, t9 o0 f3 ~, E( D' h! T
Dim dbsname As String
2 [5 p6 \4 I, xDim array1 As Variant / W6 V4 F, }/ S3 S; H" A/ @0 K X
Dim array2 As Variant ‘声明所需的变量及类型 + b/ P, U/ Z4 c7 V
dbsname = “D:\材料表.mdb” 1 m9 c) ^2 Y, q5 }! P
‘声明Access数据库写到哪一个文件
, g- T$ h6 F. q* J0 nOn Error Resume Next ( M! s1 n2 P9 F6 g- c
Set dbs = work.CreateDatabase(dbsname, _
" o- N7 S `1 o5 q9 NdbLangGeneral) ! q9 T# S- q: |9 w% s
If Err Then 3 F" f0 q) @1 H; L+ @- V
Kill (dbsname) ! J" U6 `/ v7 Q7 e% N l
‘发现要写入的Access数据库文件已存在就将其删除
$ ]( E8 B% ]/ {8 h2 P- V7 z( W& dSet dbs = work.CreateDatabase(dbsname, _ ; S6 Y# ^( [) |& \
dbLangGeneral) + X; E/ A7 F$ X5 Y
End If ; [* r. B% H: i, V9 q5 l1 j/ m
Set tdfNew = dbs.CreateTableDef ) h( X d5 s. y ]5 Z% @
(“电气 _材料明细表”)
0 x3 l3 [9 \3 a# R‘建立一个名为电气材料明细表的表
; |/ f# J/ m+ K5 v% x4 u8 y& BRowNum = 0
3 t$ n7 R4 L$ c/ GDim Header As Boolean ) O' j R X: _
Header = False
. @7 [ Z- G; ~. L$ q" k7 _" nFor Each elem In ThisDrawing.ModelSpace 6 m+ N( X* _% d: R( V- y
‘在CAD模型空间，查找所有图形对象
9 E6 z. h' v2 W; v qWith elem d+ _3 j& w1 i+ v
If StrComp(.EntityName,_
/ k+ S* _! s& ]“AcDbBlockReference”, 1) = 0 Then
+ S/ D9 q& l" N" n: F/ XIf .HasAttributes Then
2 U$ W+ E. F4 x; rarray1 = .GetAttributes % I) R: d2 h L! m; N
array2 = .GetConstantAttributes
$ B3 @0 x& E' b0 Z5 s‘设置array1指向图形对象的属性 $ L* ?) t' B2 [5 J
‘设置array2指向图形对象的固定属性
) J* p1 ^2 F& QFor Count = LBound(array2) To _ ! L" U, {" l; b' Q: n5 a# |
UBound(array2) ) r. `7 e% T. W1 k" L! w
If Header = False Then
, ]0 Q j- {' Y# i9 y i RIf StrComp(array2(Count).EntityName, _ ' c4 Q* X) U% \- N- G" C1 k
“AcDbAttributeDefinition”, 1) = 0 Then
6 T0 D0 ?) C* H; ntdfNew.Fields.AppendtdfNew._
; `# C2 \" K5 E2 C" B% y/ HCreateField(array2(Count).TagString, dbText) ( U3 X( l, z# ~* M
End If # d& j5 V2 s+ Q% ]/ ^6 B7 t C6 ]
‘读出属性值读出,作为Access数据库表的标题
, `0 ~# a# ]$ }5 S- u7 A8 T( kEnd If . D* \" I) m6 g! c& I
Next Count
; w+ [0 F0 U( X7 rFor Count = LBound(array1) To _
9 I5 Q3 f: z7 ? y1 KUBound(array1) 5 r n- R2 z( |) N$ A
If Header = False Then ( x( Y" r4 w4 o- {; w
If StrComp(array1(Count).EntityName, _ 4 {; E) @$ v. Z% @# d
“AcDbAttribute”, 1) = 0 Then % I2 ?7 N5 \9 j- g
tdfNew.Fields.Append tdfNew. _
( }/ c, ^) h" l; \& JCreateField(array1(Count).TagString, dbText) , N1 O9 H. F7 }5 r( |1 m
End If
3 T# _ @( \0 i' C; ZEnd If ; Y+ d" x |) V3 s6 R& C
Next Count
7 _% F& s. E4 BIf Header = False Then 6 I3 K+ v3 j5 A
dbs.TableDefs.Append tdfNew ) z% g1 l, i4 G5 z
Set rs = dbs.OpenRecordset
7 Z. V7 O1 M! o+ f- i w(“电气材料 _明细表”, dbOpenTable) ‘打开记录
" b( p; R4 H0 P1 B; J3 REnd If
3 x/ _& z' m6 @% ^. W- g6 V, ZRowNum = RowNum + 1 ( g7 K" `% o) \/ I5 b* T; {
rs.AddNew ‘增加一笔新记录
5 _) ~, }2 O8 s \& K/ lFor Count = LBound(array2) _ , [" y1 U$ A: I
To UBound(array2)
' J+ ]' b4 k7 p- y8 d5 e2 Zrs(Count).Value = array2(Count).TextString ( ?, r) p; h3 R0 T: t) L
Next Count ‘读固定属性值 6 G. w- G5 g: H% Z2 M) y8 ?& Y
For Count = LBound(array1) To _ V# Y0 T1 A. w/ O8 E% e
UBound(array1) 0 \1 x: z: z5 z
rs(UBound(array2) + Count + 1).Value = _ Y7 d/ L: J! E
array1(Count).TextString - S: ?: W* z& S+ H) ~
Next Count ‘读输入属性值 % F% _2 |7 @# G& \$ m! t! A, J5 |
rs.Update ‘增加新记录修改结束 ! l* |. u4 `, g& z
Header = True . P* m1 U5 A, Y) v/ d
End If * ]2 U4 m( h' e( T3 r
End If
* `6 l/ T- ]8 XEnd With h7 N: L* i/ \ d: \) g( C- f! \
Next elem % W; k: f8 N7 E8 C
rs. Close ‘关闭记录，释放资源
4 S) ?8 V$ @! l5 p7 }7 zdbs.Close ‘关闭数据库，释放资源
; ]! b7 B7 G" d/ SEnd Sub |
|
发表于 2008-10-17 16:08
