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()
# _0 P; i5 T% `Dim work As Workspace
5 n/ [8 ]) u& j& ~+ l- n9 Q$ gDim new As Database 0 M0 Z+ U. H+ e+ S
Dim elem As Object * D4 k% I$ |$ x
Dim rs As Recordset 0 }1 ]& r* R; r- T
Dim RowNum As Integer
0 X/ X% [% r! F+ B- P5 Y' ^' g+ r- a7 VSet work = DBEngine.Workspaces(0)   }* N- Y8 D6 ]2 [: N& ^' t
Dim dbs As Database
3 B" Z0 ^+ P$ K: T" U+ M3 \6 }Dim tdfNew As TableDef 8 e9 a, t% |2 E* O7 u; S- E
Dim tdf As TableDef * Y) k6 X% I! A" r' x  T, f( k
Dim dbsname As String
/ q$ g# v/ R+ M/ o+ l- @Dim array1 As Variant 2 O2 |* o8 }1 V! d! I  e1 @
Dim array2 As Variant ‘声明所需的变量及类型 , P2 ~* y) w4 o) ]$ X
dbsname = “D:\材料表.mdb”
8 [9 {& [0 l4 H‘声明Access数据库写到哪一个文件 . ]% Q( V/ {8 `4 F' Y8 z
On Error Resume Next
/ A. t& B  Y7 c, @* \Set dbs = work.CreateDatabase(dbsname, _
7 a( t* v+ Q! NdbLangGeneral) + z) }( M/ W5 J. b1 t" N& a
If Err Then
5 L8 X+ b% X- F4 t" pKill (dbsname) 8 j  n% e/ o" u) D/ G; ?
‘发现要写入的Access数据库文件已存在就将其删除 5 n; a( ?  e( @+ ?9 N5 u
Set dbs = work.CreateDatabase(dbsname, _ 1 U# n, t4 \6 V9 U
dbLangGeneral)
4 z4 k1 L: \! M/ }  jEnd If % c6 _- @3 E8 ^. O6 B( @6 e
Set tdfNew = dbs.CreateTableDef 7 h) A6 O) n/ c8 l
(“电气 _材料明细表”)
, |" ~* b+ ?9 D! ~' ]* ^2 p$ L‘建立一个名为电气材料明细表的表 $ R9 p, h3 e3 |6 S) j
RowNum = 0
  X7 z0 t5 j: j5 }1 m, j2 d/ ADim Header As Boolean
; }  k  S4 Q' y$ _Header = False
  I1 j% o8 }/ o) t  X' iFor Each elem In ThisDrawing.ModelSpace * @7 p& s7 e7 Y
‘在CAD模型空间,查找所有图形对象 $ T2 P& ?, }1 ]4 S
With elem . b2 L/ V. G; T$ R8 E: v1 n
If StrComp(.EntityName,_ , B/ \% {/ U# s# e# ~2 P& R
“AcDbBlockReference”, 1) = 0 Then
- F+ \% W: E( w' |0 U  e  lIf .HasAttributes Then
* c9 A; R) U/ b6 W& [4 harray1 = .GetAttributes 4 p0 _$ s/ A( F- ^2 r5 Y
array2 = .GetConstantAttributes
+ _! ]5 u" F* C7 o2 o3 c1 q‘设置array1指向图形对象的属性 % Y9 y# i1 \$ }" r" I$ p
‘设置array2指向图形对象的固定属性
% b' ~/ m  w3 \. }For Count = LBound(array2) To _
, F+ a' Y2 c. X9 |9 Z% oUBound(array2)
' G) Y$ e: y4 u$ q% B: i# E# U5 V! SIf Header = False Then ! d- P6 Q* v! V- M1 w' e
If StrComp(array2(Count).EntityName, _ 2 `  X/ @" b' S$ G4 n! s# z
“AcDbAttributeDefinition”, 1) = 0 Then " C* W. s$ l6 T
tdfNew.Fields.AppendtdfNew._ 1 a3 R* g. T, o5 ^; r) X
CreateField(array2(Count).TagString, dbText) " W  N" G1 v$ |
End If
3 [7 P; Q, x" f7 B( f‘读出属性值读出,作为Access数据库表的标题 + Q) {3 n6 r, ^9 s) f
End If + m" ]# n% V- J' B% t' v
Next Count
3 w9 a* M: k# u+ [: d5 \! sFor Count = LBound(array1) To _
: @) _8 Y6 n* d  ^* o9 k5 GUBound(array1)   E$ }# k7 |3 l# @% p' |6 r
If Header = False Then - e0 A- p. Y; n8 X# ?
If StrComp(array1(Count).EntityName, _ & s7 @# N7 V1 H: F
“AcDbAttribute”, 1) = 0 Then
8 A; m4 _, x, N7 E0 UtdfNew.Fields.Append tdfNew. _
/ @2 D! ?# I0 @9 _+ FCreateField(array1(Count).TagString, dbText)
' c$ `& q. Q5 R" v# k% g. VEnd If
4 u! i5 v& a7 l+ e' UEnd If
+ L  n( i+ z  g2 z& b6 P( D0 BNext Count
' T  z# K; u# H6 ^# v4 ^3 k! kIf Header = False Then
- X2 Q8 ^2 C2 |3 Fdbs.TableDefs.Append tdfNew
2 @  X% }$ x* ^" L: _* U6 u1 xSet rs = dbs.OpenRecordset # Y, i: D/ `, y2 p6 g
(“电气材料 _明细表”, dbOpenTable) ‘打开记录
2 L% E- y0 W8 X1 LEnd If
+ S. \0 @6 ?0 N' D. t$ n9 P6 |RowNum = RowNum + 1 & X% o, ^% z: |. B3 x) `$ i
rs.AddNew ‘增加一笔新记录 * S! I0 c  l1 h9 B8 C& b
For Count = LBound(array2) _ ' q" ]0 V: |6 l: c
To UBound(array2)
  [4 U1 g/ A( \. ~3 z* G4 D- Ars(Count).Value = array2(Count).TextString 5 J1 B* E' t& E/ v, p) @* k
Next Count ‘读固定属性值 " o4 T" r2 S+ |2 C3 p
For Count = LBound(array1) To _
+ y: v' ^( n4 H8 }! ~/ N, M* HUBound(array1) 3 w* q8 ]( F! u) h( D4 `$ q
rs(UBound(array2) + Count + 1).Value = _
/ {4 P, y7 e& H$ Y) G$ j- P  ~array1(Count).TextString
- ]* H3 X0 l+ S% f6 H2 uNext Count ‘读输入属性值 " @8 X* v: E3 {9 q$ }: ^/ j) e
rs.Update ‘增加新记录修改结束
5 Z4 J& ~2 T9 f2 g* @7 NHeader = True
1 u; F4 C+ K! p- C) P! V6 wEnd If 3 D2 N0 n( \6 g# j, S5 Z
End If
7 V' Y# w5 t/ A; |9 L9 Z- wEnd With
+ h! ~5 f$ x4 N* J4 W" d% g6 n7 ^. w. DNext elem ' K8 U: x/ O' ^9 p; F1 v, v! l8 `0 Y
rs. Close ‘关闭记录,释放资源
  |: s3 k3 a' E) ?; V; x9 {4 B( `dbs.Close ‘关闭数据库,释放资源
) e5 e- o( X: tEnd Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot
- H1 L/ U$ j; p真是太好了 $ J: U. w$ H. b0 y/ |1 t
這就是我要的 ^^
发表于 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-22 01:28

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

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

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