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() - z2 r7 Q$ `# |( j  @! |
Dim work As Workspace
; b1 B% G" I! uDim new As Database 6 p% w- ?0 j0 D3 a0 T7 |
Dim elem As Object * n" v1 k5 M, w
Dim rs As Recordset
# d$ k! m6 u/ F! B% |' k; \! RDim RowNum As Integer
( _# t( h7 Q' ~( OSet work = DBEngine.Workspaces(0) ( l7 Q% {2 D& ?/ G% e; b/ F
Dim dbs As Database 8 |7 L: P: L  m* z, u/ m4 F
Dim tdfNew As TableDef 6 x- W8 V" C) |& y" h/ ^
Dim tdf As TableDef
' Y& i/ I9 M! [+ \2 q2 PDim dbsname As String
+ P7 m) M0 Q" Z) ^Dim array1 As Variant 8 Q1 y5 F. ?  r  T) K" z9 ?$ N
Dim array2 As Variant ‘声明所需的变量及类型
5 y- j/ b; I  [- d- g  O6 R! bdbsname = “D:\材料表.mdb”
  J( X8 i# t, G4 U0 p‘声明Access数据库写到哪一个文件
/ T, b; f, Z+ J! l1 P5 d. ?On Error Resume Next % i5 u7 `$ L3 A" _- M) \
Set dbs = work.CreateDatabase(dbsname, _
/ }$ d- W0 D5 n) KdbLangGeneral) 3 M2 d/ W! a* }. g1 p# N" U
If Err Then % m3 f3 p* K2 T. R; |% n
Kill (dbsname)
* {, A: K; y, u‘发现要写入的Access数据库文件已存在就将其删除
! d- {& h6 `7 T4 h" DSet dbs = work.CreateDatabase(dbsname, _ ) b. l$ `3 Q. M- ]9 m- B+ ^" r
dbLangGeneral)
) K, u) d! {6 S# ]1 I3 [$ CEnd If
' n; b, ^0 w$ D2 v# W* xSet tdfNew = dbs.CreateTableDef
% ]5 q5 T# g$ {2 a, l& c" y(“电气 _材料明细表”)
2 X# t3 g: B2 W! C9 K: N# e4 c‘建立一个名为电气材料明细表的表   C- L% N9 \5 J3 w/ P& J4 {) [0 F
RowNum = 0
( F1 q5 R8 [2 h, jDim Header As Boolean
' U) M2 N9 E9 e2 yHeader = False
* d1 R. q; R* G$ M( G3 |For Each elem In ThisDrawing.ModelSpace 2 O8 J$ A7 j! M" X8 _2 q- G
‘在CAD模型空间,查找所有图形对象
4 |8 _; Z% @; T+ ?3 GWith elem
, Z& k- A/ z$ A1 m2 k6 VIf StrComp(.EntityName,_
& v: o: R* E% F“AcDbBlockReference”, 1) = 0 Then 3 l1 K8 J: k% P) |3 C  ^
If .HasAttributes Then
) q% m: D% _) U* o# t# ]array1 = .GetAttributes
& k4 N0 d( ]8 S1 J8 C6 T8 aarray2 = .GetConstantAttributes
! r/ K! x" ?7 R‘设置array1指向图形对象的属性
+ ^6 B, A( O" F5 _2 ?& Y‘设置array2指向图形对象的固定属性 1 G6 z' B$ S4 q. I, p8 z, {8 S
For Count = LBound(array2) To _
4 c% G+ ^( G- |- QUBound(array2) + O& U+ K% H; q0 h
If Header = False Then
, s/ o  @' h: d* JIf StrComp(array2(Count).EntityName, _
# ]2 S" v, t/ X8 T3 Q( G3 w“AcDbAttributeDefinition”, 1) = 0 Then
; |& v+ `; b6 z# s; V3 E2 ltdfNew.Fields.AppendtdfNew._ $ v( V) W* M( j0 @" H8 k
CreateField(array2(Count).TagString, dbText) ; P3 _9 O! M' ~: M/ |1 |  f
End If 1 ?. e9 I4 F8 c% ~, ^6 z
‘读出属性值读出,作为Access数据库表的标题
' P6 q3 S/ P4 Q2 `End If : j$ c1 k! n' q# J7 y% G
Next Count
! j8 V! q* |' ]9 s7 }/ b% O1 q3 QFor Count = LBound(array1) To _ * Y; f1 y  H. Y3 f+ n- I
UBound(array1) 2 p! X( c+ y8 I
If Header = False Then
# N! T. ^7 \) @9 [  O: GIf StrComp(array1(Count).EntityName, _ , Y0 j- B8 ?; X& e; e8 T
“AcDbAttribute”, 1) = 0 Then 6 C* U# P! ]# A8 V. ]( m
tdfNew.Fields.Append tdfNew. _
9 x# D) O3 F/ W' ACreateField(array1(Count).TagString, dbText)
; `. g$ y: }/ ?' M8 p$ ?End If 9 O! @. h6 P) G2 q$ c- I- P& `
End If % T/ S3 V# f8 Y6 {1 l6 |
Next Count
. ]: X- b* p6 g. B0 Q& H( bIf Header = False Then 7 F/ r! d4 k1 S4 ~/ K+ X
dbs.TableDefs.Append tdfNew , g, |! y8 a2 I. I1 F. _+ ]/ F
Set rs = dbs.OpenRecordset
6 P7 r+ f0 S0 F) h. d(“电气材料 _明细表”, dbOpenTable) ‘打开记录
+ w9 {, u) k0 i/ sEnd If 6 d/ O- L6 R* |; R6 o
RowNum = RowNum + 1 4 Y# k# F% j$ ?6 k
rs.AddNew ‘增加一笔新记录
  e5 X) ~1 l# Z) [For Count = LBound(array2) _
3 C, P0 g8 J: D$ x2 zTo UBound(array2) 0 f* _3 W/ g- \! ^
rs(Count).Value = array2(Count).TextString ) @2 X1 C% a1 |' P* B; N6 U. s& r
Next Count ‘读固定属性值 * n; L% h. o- _* c6 f
For Count = LBound(array1) To _ # ]9 d: U1 P0 @! R& a+ E! u
UBound(array1)
; \2 j4 Q: L. urs(UBound(array2) + Count + 1).Value = _ 9 }( f8 \: o5 C7 ^5 Y
array1(Count).TextString 3 B* o/ R% d, ?
Next Count ‘读输入属性值
- S2 L# R$ [0 t1 q0 @5 ?9 o; Drs.Update ‘增加新记录修改结束
3 h& S2 Z; w7 K3 |8 B& ~, t+ @9 E7 gHeader = True 0 z; b8 p5 [8 \* ]  J
End If
$ t! \4 U5 J/ Z2 Q9 aEnd If $ B# B& I" l/ U5 @
End With
4 n# h" L0 @) }6 @6 B. h0 w3 kNext elem
8 i5 u" C. F3 N1 urs. Close ‘关闭记录,释放资源
: M1 Y$ j& b9 F4 s" d7 m, \dbs.Close ‘关闭数据库,释放资源
) r5 |' K# q/ j6 U. B. GEnd Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot, A3 V" s- [) K* z2 \$ r$ U
真是太好了 2 A/ v0 }3 r! d; g& f( z
這就是我要的 ^^
发表于 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-20 06:25

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

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

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