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()
# L2 }4 J' f& `( Y3 nDim work As Workspace 5 Z( k$ i, e  O6 Y2 C" _; o
Dim new As Database % i- Y+ o2 s5 @  W# b; M" T
Dim elem As Object
6 s7 Z  P$ s, N/ [' L2 }- eDim rs As Recordset
2 s2 H( M) S4 `3 ?6 J$ B+ ?1 W, ]6 NDim RowNum As Integer ! J) C4 d; Y1 R
Set work = DBEngine.Workspaces(0)
7 [' q& ^' X: J3 e$ aDim dbs As Database : l/ `) t$ J, N+ A* U& y
Dim tdfNew As TableDef & K6 d2 h! r+ D( ^, T
Dim tdf As TableDef * V" p: m3 G5 o0 e- S- _
Dim dbsname As String
$ }  V, z, G% u2 u2 j9 z5 O( EDim array1 As Variant " A) ~- t, D% Q4 m* _7 I2 w
Dim array2 As Variant ‘声明所需的变量及类型 / o+ c1 s) N7 r$ a8 d. b5 W
dbsname = “D:\材料表.mdb” , z' z* K1 J4 s) j% n' S
‘声明Access数据库写到哪一个文件 % w. N9 M/ f& p! B
On Error Resume Next
8 [6 i8 t8 N  |Set dbs = work.CreateDatabase(dbsname, _ ' T. a6 C  N, l7 |1 j+ t0 {
dbLangGeneral)
+ C8 S# z, g. S8 W6 y' _' S) P4 yIf Err Then
& b' p! z6 @% s2 d$ `0 }. \Kill (dbsname) * n$ j$ F& l/ t; {
‘发现要写入的Access数据库文件已存在就将其删除
4 Z2 E* ~4 K/ [8 L% ~- KSet dbs = work.CreateDatabase(dbsname, _
$ Z4 p& c0 U, e  a0 X1 UdbLangGeneral) ( r' r7 ]6 c7 C8 T8 w, Q! G( U
End If * `/ A( m+ V( Z3 o4 |
Set tdfNew = dbs.CreateTableDef
2 @1 b1 Q- m4 c0 \: r0 a: s* A(“电气 _材料明细表”)
, w3 n7 R& }( _0 |; E‘建立一个名为电气材料明细表的表 / h2 g* ]* T& f7 _1 t: o' e( c- M
RowNum = 0 ; B  o; ~% ?6 K/ \/ K
Dim Header As Boolean
% \5 i  A9 V4 s9 W. g3 wHeader = False # Z) _; T3 |% F  G2 W  X
For Each elem In ThisDrawing.ModelSpace
3 g" Y4 m3 g3 c6 T( u‘在CAD模型空间,查找所有图形对象
- x8 D" {- M- [  dWith elem
  |5 I% q! r1 n& JIf StrComp(.EntityName,_ $ |3 P6 D1 q; p, p1 |) d; c7 I
“AcDbBlockReference”, 1) = 0 Then " d% [5 h: `8 e! l  U+ L
If .HasAttributes Then
; q5 J" i  q9 c1 E/ varray1 = .GetAttributes 4 s9 u) P4 P% R8 m- b6 `/ ?/ R1 r6 l
array2 = .GetConstantAttributes   L# k* \) z! F6 p) j7 o& P0 ^
‘设置array1指向图形对象的属性
* |6 @% [: ?- P# Q‘设置array2指向图形对象的固定属性 6 U% ]' F9 v" [
For Count = LBound(array2) To _ - [3 c  G) o' \* s2 L2 a$ J" H
UBound(array2)
& n% K+ s% I+ t! x( ^  KIf Header = False Then 1 ?# ]5 Q/ z$ s8 V% {- q
If StrComp(array2(Count).EntityName, _ 4 z$ ?9 n7 K( E; ~& N* f4 m- ]
“AcDbAttributeDefinition”, 1) = 0 Then
  z: T$ F/ l2 I% |  o* `1 itdfNew.Fields.AppendtdfNew._
0 D& R$ F) P' n$ @( A+ Y; }$ S; dCreateField(array2(Count).TagString, dbText)
( T' \8 ~/ \, z! g, Q" F' JEnd If - [! F. t' m4 l3 i
‘读出属性值读出,作为Access数据库表的标题 1 a4 X& H% P, x# _/ J& I2 {
End If ) P. J4 x1 \5 T# x2 ~
Next Count 7 ?. U1 u1 u: ~. s% m& k" M: A+ L+ F: l
For Count = LBound(array1) To _ ' U1 R8 p' S  G$ P( r$ ]
UBound(array1)
/ t( l3 a$ _$ [" _If Header = False Then
" U6 p' p2 E) u( Z& f( LIf StrComp(array1(Count).EntityName, _ , g$ T0 Z5 d: h, N& F& n  e6 Q( V
“AcDbAttribute”, 1) = 0 Then
! F! w, Q. e9 D  @+ M4 mtdfNew.Fields.Append tdfNew. _
- s* T# v  n" Z$ ?5 e( p. vCreateField(array1(Count).TagString, dbText)
. D" _" e' o/ G# F5 f# nEnd If
1 I) B/ D' k: @5 J$ Y6 WEnd If
3 X" E, z6 w9 T8 Y! `, n. l3 H. I% DNext Count
/ x' t- C) U7 WIf Header = False Then : S' E8 h  Y) j
dbs.TableDefs.Append tdfNew 8 Q5 n3 f6 C. i- k  [6 o6 P
Set rs = dbs.OpenRecordset
' j) O( h" i9 r# b) O' B0 O(“电气材料 _明细表”, dbOpenTable) ‘打开记录 % t% m" R5 W/ I, Z8 n; U! m
End If
# }4 M( V. ?0 YRowNum = RowNum + 1 * X7 S7 \7 o$ H5 c% D0 s3 f0 N1 k* @
rs.AddNew ‘增加一笔新记录
! A' }: S9 [0 ?9 h5 S7 u, AFor Count = LBound(array2) _ 0 e% W+ [: L$ m$ z- u6 {; w
To UBound(array2)
+ q2 Z9 ]+ w2 T3 I  @# f% C8 n+ Irs(Count).Value = array2(Count).TextString
# ]2 S  u6 H  P. a$ uNext Count ‘读固定属性值 : U% e1 d" W- Q4 C0 i, ?3 _
For Count = LBound(array1) To _ 2 Z# o, x( Y# J3 h0 q  D
UBound(array1) 1 h% c) [, X7 A' `4 n
rs(UBound(array2) + Count + 1).Value = _
) x6 p$ G: N) L' I3 karray1(Count).TextString
2 \9 F" k3 v! j3 O% O7 oNext Count ‘读输入属性值 / `, ]: k' @! T/ \1 _
rs.Update ‘增加新记录修改结束 , r3 T, w* [3 l# g0 }/ W
Header = True
* _6 D2 S. H) L4 \End If 7 [: z- W; {4 U' f7 P3 {
End If
3 }, h' X6 x% c5 r8 d. c% sEnd With
) m' ]7 r1 T% ZNext elem + j- \; U; z2 I; `# i7 c
rs. Close ‘关闭记录,释放资源 ) A8 W  g* G& N1 b; X2 P6 k) I
dbs.Close ‘关闭数据库,释放资源
0 ]8 R8 \4 P) L' jEnd Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot0 [1 T4 d% a) x; B1 Q  L* `
真是太好了
  n' C3 T" S4 v這就是我要的 ^^
发表于 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-31 03:04

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

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

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