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() + j- g* e" c9 Q& r: j( H+ t
Dim work As Workspace * B; `& b6 @; q% R& W
Dim new As Database ' E* R+ C' ?0 D1 H
Dim elem As Object
  w1 x- C) m; g9 ODim rs As Recordset
8 L& i0 |+ A# U4 FDim RowNum As Integer 4 D! ^) _3 M8 T
Set work = DBEngine.Workspaces(0) + o$ R# [3 f* d: D9 Y: h% U
Dim dbs As Database 0 |9 d9 H) u; N: m# i
Dim tdfNew As TableDef
" I& ]2 K$ T# v, }' @Dim tdf As TableDef 7 b1 _& c$ A  F+ N7 G+ L  }' w2 U
Dim dbsname As String ) f, C; W1 Y& g
Dim array1 As Variant
+ h% f  ]( b/ T( S6 F# Q2 e( eDim array2 As Variant ‘声明所需的变量及类型
$ J" ^4 x; C# u- F3 ]! Ydbsname = “D:\材料表.mdb”   i/ b7 S" I4 c; P0 Q
‘声明Access数据库写到哪一个文件 ( J0 K8 i& }/ n+ u
On Error Resume Next ( y' Y. \$ a& O! z7 [
Set dbs = work.CreateDatabase(dbsname, _ * E3 Y/ I) o, u: e
dbLangGeneral)
$ d9 E- t4 f% H/ j7 F4 H7 {8 \1 n& ~If Err Then
  D" I% K! y$ iKill (dbsname)
3 a, a/ V/ L" P5 y+ w/ t‘发现要写入的Access数据库文件已存在就将其删除 0 J$ P7 O; @) Q- T
Set dbs = work.CreateDatabase(dbsname, _ $ g3 {' q2 F; P9 |# \
dbLangGeneral)
! G0 V  \! g2 WEnd If " @: `& S+ e# G  y" E; P0 w. Q, J0 Z
Set tdfNew = dbs.CreateTableDef $ f  Z8 z% f# a, ~9 y
(“电气 _材料明细表”)
0 Q) g5 i* V) Q6 B‘建立一个名为电气材料明细表的表
% [% V- z6 m4 Y2 c' oRowNum = 0
; p* e% F6 ^; n6 J6 Q1 J! X* {Dim Header As Boolean
! V8 {2 k. O" D/ [5 pHeader = False ; l5 T3 A9 ]# i
For Each elem In ThisDrawing.ModelSpace
- M4 f/ \0 \4 J3 u& l( Q7 u‘在CAD模型空间,查找所有图形对象 / i: e! b9 u- v2 x( e% B0 f$ ]; t0 L
With elem
$ `" ^1 P6 |; A$ ^/ FIf StrComp(.EntityName,_ 3 |" L5 `8 J$ s; A" U- M, p6 g% U" h
“AcDbBlockReference”, 1) = 0 Then
8 H' [( Z- d# v; f' ]If .HasAttributes Then # a6 x! n+ u  Z* u" D
array1 = .GetAttributes 7 `  ?0 b& h) C  ^7 n: U
array2 = .GetConstantAttributes ) Q& E: \, I9 R1 j( q0 @- ?
‘设置array1指向图形对象的属性 / @2 y% m8 `7 o# c! X; i8 w
‘设置array2指向图形对象的固定属性 - H9 N3 }, b/ {: o- s
For Count = LBound(array2) To _
; z. x7 Q% ^. V( WUBound(array2)
" m. |7 }9 G& Q- z; E7 }If Header = False Then
, Y- J4 w, x$ B5 X9 N# ~- }& eIf StrComp(array2(Count).EntityName, _
5 j) @  s3 L1 e% j“AcDbAttributeDefinition”, 1) = 0 Then
2 }9 `6 g* H. N6 e. B  `, p: `' q3 ftdfNew.Fields.AppendtdfNew._
& j% F5 C, t) uCreateField(array2(Count).TagString, dbText)
' O& _3 f! T" Q) n8 [8 WEnd If / A. q  O. c" w& R5 @
‘读出属性值读出,作为Access数据库表的标题 0 _$ }6 }5 a4 d
End If
) Q1 A, `7 ~; d- }! Q5 xNext Count
- ?. G: [5 B9 C7 m$ @For Count = LBound(array1) To _
/ s, H) {) @8 |, Z/ p* gUBound(array1) 8 a' o, q3 q# Q- K
If Header = False Then
' r4 y3 n( I/ ~$ V# T: AIf StrComp(array1(Count).EntityName, _
, p& K+ u. u8 N6 W“AcDbAttribute”, 1) = 0 Then
# F7 `5 h+ ^6 J( ltdfNew.Fields.Append tdfNew. _ : I& X9 c) f1 F
CreateField(array1(Count).TagString, dbText)
: @% ]. U/ t7 e3 |, O$ C! pEnd If
- m: h. Y' `9 t5 C# }7 F- IEnd If
4 H7 Q( a, d+ j$ N, vNext Count
5 m' S6 j" u9 a) R" B* WIf Header = False Then
7 i, v! J( z4 Y$ wdbs.TableDefs.Append tdfNew
" ]2 H  z+ y2 D. e, RSet rs = dbs.OpenRecordset   |2 V2 @7 h# e: s! T; v
(“电气材料 _明细表”, dbOpenTable) ‘打开记录
: Q6 _4 A6 \* O+ x" v. [End If 3 [$ j7 d4 \( z( h0 w8 [
RowNum = RowNum + 1
% N& {0 E2 Y" r9 r" y+ Y$ Qrs.AddNew ‘增加一笔新记录 $ W. N( h/ W& \6 W7 n
For Count = LBound(array2) _
( u* N. C- W7 E) vTo UBound(array2)
) R8 y1 ?4 s! l" H" Grs(Count).Value = array2(Count).TextString ) a& q$ Z0 c! v/ Q# m
Next Count ‘读固定属性值 + T4 d# ~4 U( Y1 u9 ~- N' B7 |
For Count = LBound(array1) To _ 4 G+ p: p# T% ~- J  W2 I- c( F4 T
UBound(array1) ; e: v. c2 b$ f$ J8 ?. E  P+ @8 E
rs(UBound(array2) + Count + 1).Value = _
! ^6 T% [8 H- h2 ~6 ^- w- a1 Carray1(Count).TextString ' {- X" L% K; m$ I
Next Count ‘读输入属性值 8 j- \* l6 x% p% [; d6 Y; D
rs.Update ‘增加新记录修改结束
- y8 \& O9 w: a5 }" h$ Q- v0 M" jHeader = True & @( \) p( n/ g: h  Z
End If
0 S: v: a1 i" Z7 o! IEnd If
8 o3 f8 j$ `3 |7 `1 O. MEnd With 9 ?  w9 b% i! D
Next elem
; Z: A- E, t. w4 L" grs. Close ‘关闭记录,释放资源
2 b/ ?, O2 F' O3 ~9 _+ Udbs.Close ‘关闭数据库,释放资源
' [$ y$ v( V  ~1 l# `6 |, |0 F" fEnd Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot
0 {# A" e0 W* a8 t! H' m. ^; _# Z真是太好了
0 W) j( h- V" r& I4 G2 ?5 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-2-11 19:16

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

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

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