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() - W* q2 p! Z9 |4 {* W/ d8 P
Dim work As Workspace 0 b4 ^/ u! i$ M8 w( Y& B/ e# X
Dim new As Database 9 E7 O8 ~3 M: \, c6 I8 K- p3 o; w
Dim elem As Object
8 A& A: k8 n6 J( Q7 ?0 J# oDim rs As Recordset " Z" p0 k  Z* M0 N0 p
Dim RowNum As Integer
. t" f- y7 V7 B' LSet work = DBEngine.Workspaces(0) 4 n& A0 T1 m- C, \8 D/ ]; _
Dim dbs As Database 3 q: a, `5 u) s, ?7 M
Dim tdfNew As TableDef ' o2 V! Y! V7 J/ ^- P
Dim tdf As TableDef
% B6 u9 g0 s) e4 j+ ?! UDim dbsname As String
7 I% z+ f, I6 ^8 UDim array1 As Variant
8 y8 r6 j5 M  P- y" XDim array2 As Variant ‘声明所需的变量及类型
0 n8 Y+ B3 S. u2 K0 E4 s7 Vdbsname = “D:\材料表.mdb” ( s2 ]2 Z% M" \2 ~6 F
‘声明Access数据库写到哪一个文件
4 c4 J( g) u, {1 Y' h* i) ~8 Z/ o1 |On Error Resume Next ' G8 d& h' M4 F& X
Set dbs = work.CreateDatabase(dbsname, _
& i0 m  E# s5 l5 g2 \( O# HdbLangGeneral)
: ?- u1 e5 a/ T: RIf Err Then
/ y7 i0 V0 \4 S& Y4 m1 v" q6 d* \Kill (dbsname) ; A$ \7 u1 [- a# ?! @/ M
‘发现要写入的Access数据库文件已存在就将其删除
1 [; L' N4 A5 E7 m( ySet dbs = work.CreateDatabase(dbsname, _ & o1 G% V/ F6 |% E( F1 X
dbLangGeneral) ! f4 W$ `5 d( M6 i; y- i# j
End If ; V  D4 Y# R. S
Set tdfNew = dbs.CreateTableDef
" ]4 u8 s9 A6 j0 r4 G  P(“电气 _材料明细表”)
$ V( \& L6 e7 V) Y6 K) r& v‘建立一个名为电气材料明细表的表
; ], o& ]3 \, A0 R6 c: \, l  k4 k3 YRowNum = 0
; h. B1 `' F8 eDim Header As Boolean
- P' I1 l% U0 _% z1 h" aHeader = False ; S. }' l! G8 u3 n* T4 i
For Each elem In ThisDrawing.ModelSpace
3 M- P& s8 \0 p$ E) d( {‘在CAD模型空间,查找所有图形对象
! l& Q+ L2 C$ A9 Q  O# x. a. ZWith elem
* J% z9 X& i3 x7 ]' K, uIf StrComp(.EntityName,_
8 C  g% y  E, S' J  _$ D“AcDbBlockReference”, 1) = 0 Then
! U) e% e0 `; {$ I% k- t/ ?If .HasAttributes Then " S* ^9 G6 v/ H$ H% B% [( r3 ~, E
array1 = .GetAttributes
- s1 C+ j/ X4 P' c6 qarray2 = .GetConstantAttributes * E* v2 \$ _  u4 [1 I8 |8 J
‘设置array1指向图形对象的属性 ) i, z/ O3 E& l' K+ |( D
‘设置array2指向图形对象的固定属性
) J# d, _& r8 S! X) H9 x" YFor Count = LBound(array2) To _ ! N1 }5 b1 |9 I7 G
UBound(array2)
7 j) i8 v, J1 t. X6 ~& NIf Header = False Then
0 g. r5 c8 s, W) ~; O6 |+ B/ YIf StrComp(array2(Count).EntityName, _ $ a- ~5 d1 j& G6 F- f
“AcDbAttributeDefinition”, 1) = 0 Then $ V4 V* s! k6 U1 r
tdfNew.Fields.AppendtdfNew._ * H9 X+ K. }2 B
CreateField(array2(Count).TagString, dbText) ( r8 k4 x3 {: q6 A  P% I
End If
8 ^. x1 o8 `. f) S‘读出属性值读出,作为Access数据库表的标题 3 W) B  ]# C. p' l
End If
  }+ n# q1 E0 C  eNext Count
% D" ]' i% `" D/ lFor Count = LBound(array1) To _
% K* @1 c% P$ S  @0 T( {# g4 LUBound(array1) 9 d3 }5 [$ W& g& @& w( c8 y% k
If Header = False Then
( N+ c- `' V% p& Z& O' bIf StrComp(array1(Count).EntityName, _ % d  Q& t; w' v4 D9 I5 X
“AcDbAttribute”, 1) = 0 Then 1 i6 B# x$ O- ]& ^- O& _
tdfNew.Fields.Append tdfNew. _
1 _7 L. ^# g! iCreateField(array1(Count).TagString, dbText) ! X9 ~  M9 ^3 h+ I
End If   r! Z3 V: P4 \; T+ l. ^5 X
End If - _. ?. u* o4 K# ^* F5 }0 b5 U: U
Next Count & Z1 F( |) W6 F3 n  u: I  _9 d
If Header = False Then 8 \! V5 A' y4 @$ Q: U. L
dbs.TableDefs.Append tdfNew
) i' ^) P1 E& H1 }. B6 |Set rs = dbs.OpenRecordset
3 N  f" _0 G" G1 O(“电气材料 _明细表”, dbOpenTable) ‘打开记录
" ^, ^+ s+ p( M  Z7 |/ L' O' \End If 9 P. ?7 D* D0 Z- b
RowNum = RowNum + 1
0 F0 o. y7 f/ Z  s' Z3 C! U- Srs.AddNew ‘增加一笔新记录 - Q# I7 x+ e  q6 h9 S
For Count = LBound(array2) _
6 n7 i5 j0 f5 T; h; ATo UBound(array2)
( z  h* H1 H1 O# j0 T2 `" frs(Count).Value = array2(Count).TextString
) W1 e0 `/ [* BNext Count ‘读固定属性值
9 o) t- k5 j$ V* tFor Count = LBound(array1) To _
7 d. L3 \# m& |9 W9 V+ ]. MUBound(array1)
2 a, V4 C2 b( ?0 N7 L2 ~+ X0 }7 nrs(UBound(array2) + Count + 1).Value = _ % T+ {$ N+ z2 p5 p/ q9 w# o
array1(Count).TextString 7 i+ ~0 b1 {( X* u9 M- T! d
Next Count ‘读输入属性值
* p0 m" j) f" Z/ D3 ars.Update ‘增加新记录修改结束 6 E! t" _( I2 ~+ n/ h9 T
Header = True
% a, V; Y. I* s: S, s6 r: QEnd If
1 R4 G9 N' C) yEnd If
1 I6 l+ Q- M6 J; O% G; w$ J' wEnd With 6 A" E5 c, R  v  q
Next elem 2 c7 B( g  a: e- G3 f6 ]
rs. Close ‘关闭记录,释放资源
" i# ]' B* M) odbs.Close ‘关闭数据库,释放资源
  m4 N1 {5 w/ |) ?! ?( {; yEnd Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot
7 q0 V% G+ |" B* k7 `$ n真是太好了 : S5 t/ m5 w, p# k, h
這就是我要的 ^^
发表于 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-23 07:15

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

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

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