CAD设计论坛

 找回密码
 立即注册
论坛新手常用操作帮助系统等待验证的用户请看获取社区币方法的说明新注册会员必读(必修)
12
返回列表 发新帖
楼主: gysheng

cad统计材料表

[复制链接]
发表于 2008-10-17 16:08 | 显示全部楼层
下载不了了????
发表于 2008-10-17 16:10 | 显示全部楼层
怎么下载啊,为什么下不了?
发表于 2008-10-20 15:19 | 显示全部楼层
不知道是做什么用的
发表于 2008-12-10 13:25 | 显示全部楼层

顶起

请用过的同志说明一下怎么用
发表于 2009-1-6 13:04 | 显示全部楼层
Sub list()
% D. z( S! q: O3 v4 i/ f" `7 U) nDim work As Workspace 1 M! V# j% j4 x+ r2 L8 J* B
Dim new As Database / e5 W, v: J4 K
Dim elem As Object
& H$ Y1 G0 s7 k( BDim rs As Recordset / O8 S! n1 H" v& l, L. }% q
Dim RowNum As Integer
! n$ ?2 e! `/ Z# }+ YSet work = DBEngine.Workspaces(0) 9 |/ @3 U3 f( e/ @
Dim dbs As Database
) T$ p. v4 q, S3 Y- L& RDim tdfNew As TableDef 0 G0 h1 ~' Y  W2 }0 M6 j
Dim tdf As TableDef , A; r" ]7 J3 C3 v, }& u/ n
Dim dbsname As String / G, M7 j/ }( n, R5 I. l0 x
Dim array1 As Variant / d, Q  b' w. I3 a+ ^$ W
Dim array2 As Variant ‘声明所需的变量及类型 # P$ P3 A- }4 S! i3 e
dbsname = “D:\材料表.mdb” & a! C' S1 u1 W7 h8 u
‘声明Access数据库写到哪一个文件 . j0 m- y2 ~) C+ w3 u* B3 s. }0 o: N
On Error Resume Next
% ^- z* v  O" j6 @Set dbs = work.CreateDatabase(dbsname, _
+ b+ f* e2 `+ fdbLangGeneral)
3 h4 v( S9 F- q! e, v/ W1 j# BIf Err Then
* z3 g' ?5 \) t  y4 OKill (dbsname)
2 x2 E( N% H0 c5 P‘发现要写入的Access数据库文件已存在就将其删除
1 H( R" a$ v' @2 zSet dbs = work.CreateDatabase(dbsname, _
9 X+ A: ~: J& @dbLangGeneral) / n6 u9 o$ B' u+ C7 ^3 \
End If
6 A7 [& {; X; R; X0 J0 f5 B2 q6 A9 USet tdfNew = dbs.CreateTableDef
8 |0 x) |  M# x. I! K0 {8 e(“电气 _材料明细表”) 7 m& D. O8 w" o4 q  _8 n+ q
‘建立一个名为电气材料明细表的表 1 z, f* n1 x& ]9 Z- o' A5 f9 ?5 n
RowNum = 0
3 Y% u; t; Y% {! p; QDim Header As Boolean 4 x) t- R- [4 p+ s& z0 }/ e1 u4 |# b
Header = False
, G( I. L: b6 ]* k9 NFor Each elem In ThisDrawing.ModelSpace ' l/ o# o+ ?( o
‘在CAD模型空间,查找所有图形对象 & G- M* C% c. M' h0 Q
With elem 3 y$ y! w) T; U0 A' G, Y/ `
If StrComp(.EntityName,_
/ T& J! p* L3 b2 v“AcDbBlockReference”, 1) = 0 Then
1 M; u, x. g; C% oIf .HasAttributes Then
6 H& @* v8 c) v/ Z4 _' ]: @7 j2 x" ~array1 = .GetAttributes
. Y' ^. o6 @5 e( t! c( G" D, Yarray2 = .GetConstantAttributes
" d! E- K% T, M! d1 O* c‘设置array1指向图形对象的属性
7 i8 t# s  Z( H5 Q: J‘设置array2指向图形对象的固定属性
, t2 Q$ d& }8 s/ |9 a9 n& oFor Count = LBound(array2) To _
( \# C* K, M! D) x  A4 k( kUBound(array2)
5 ]1 D0 E, i. X3 \! y" \If Header = False Then 0 n% o9 X$ t/ O1 p
If StrComp(array2(Count).EntityName, _ 1 N& `1 i+ d1 f! O
“AcDbAttributeDefinition”, 1) = 0 Then ( g. _$ c- p( G' W' m& |
tdfNew.Fields.AppendtdfNew._ ; U- T2 u3 [  I; }" m! s, H7 f7 D
CreateField(array2(Count).TagString, dbText) 1 F4 O! {2 E/ r( f
End If
- |$ ^' |, u, ^+ M‘读出属性值读出,作为Access数据库表的标题
$ X; a- R, e8 s! q# oEnd If
( ~7 z; z% w  }* yNext Count # }) Y; L, H" R5 ^5 C+ x
For Count = LBound(array1) To _
- W+ V! b% D% qUBound(array1)
1 J2 M5 S, F0 Q  H; {6 ^- |1 YIf Header = False Then
/ y: U1 D  v. d# `$ k) YIf StrComp(array1(Count).EntityName, _
4 }6 V: k/ E& i" q% D: `, ^“AcDbAttribute”, 1) = 0 Then
3 t  P4 f3 g- Z. |tdfNew.Fields.Append tdfNew. _
5 ?% K& P7 t- U3 F1 MCreateField(array1(Count).TagString, dbText) " _: X+ J+ X3 @7 ^
End If % h" b/ Q/ e( ^$ u
End If
) B( S3 z* n( T6 A3 d7 z0 l" M% R$ QNext Count , `, O3 g1 K$ T" m7 P
If Header = False Then ' B# P4 I0 C3 }( p
dbs.TableDefs.Append tdfNew
, c: A, g& f. ]* c( X; K5 MSet rs = dbs.OpenRecordset - Z/ D1 ]) c7 y/ _% l
(“电气材料 _明细表”, dbOpenTable) ‘打开记录
" n3 c4 o2 E' z  g8 A+ p1 Z# NEnd If
0 C" ~9 C' W1 p+ ~, RRowNum = RowNum + 1 1 j) I% J: B; Q) v
rs.AddNew ‘增加一笔新记录 2 i) {! X% z+ B
For Count = LBound(array2) _
7 A' s" Y9 z% J6 b0 p9 D( s3 t: hTo UBound(array2) & N/ l3 l8 {* ^/ O* v* T) J
rs(Count).Value = array2(Count).TextString # X) ~1 ^" G2 r$ `& ?7 }! F
Next Count ‘读固定属性值
: q5 ~9 t3 \# c9 xFor Count = LBound(array1) To _ $ M$ ^/ d: S4 p$ B
UBound(array1) ) v1 K1 X# B: T8 c2 A3 J. v
rs(UBound(array2) + Count + 1).Value = _
6 M; q; S1 {6 barray1(Count).TextString 7 @) S6 {6 ^; s: l! \% E0 E
Next Count ‘读输入属性值
* G3 ?8 V1 J9 t- l! Z& f3 }rs.Update ‘增加新记录修改结束
( G: [8 b$ @* l8 M/ d; G7 FHeader = True
/ R; _0 t4 o6 I# lEnd If 7 Z4 o: \2 a) u
End If ( t# Y) b% b& s" z: R) y
End With - O4 V! O4 d& a) P) g5 q" R( K  y
Next elem 2 P/ X% t; z, P$ e5 j6 ]
rs. Close ‘关闭记录,释放资源
$ b, s  I6 ]+ j  R: u& Gdbs.Close ‘关闭数据库,释放资源 + W# B) W7 {8 x  Q0 \1 ~
End Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot
% g) t1 P! d) g2 i* \7 F+ a2 P真是太好了 " _) A+ z, }" E/ L5 G9 W& a& q
這就是我要的 ^^
发表于 2010-5-11 23:13 | 显示全部楼层
好用吗?有谁下载了?
发表于 2010-8-24 19:08 | 显示全部楼层
学习学习!
发表于 2010-10-25 14:37 | 显示全部楼层
先看看看再说
发表于 2011-2-21 05:48 | 显示全部楼层
下来看看先,谢谢了。
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

关于|免责|隐私|版权|广告|联系|手机版|CAD设计论坛

GMT+8, 2026-1-29 05:13

CAD设计论坛,为工程师增加动力。

© 2005-2026 askcad.com. All rights reserved.

快速回复 返回顶部 返回列表