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() ! m. J0 P8 O; {4 s% ?3 M* X% O# X* a
Dim work As Workspace 2 |2 N  z; F- \9 w6 m; r- N$ x
Dim new As Database
; W  [/ e# m) G1 q" u: g+ C" a. jDim elem As Object " `5 Z3 V3 F; f7 @0 ?8 _+ {0 n
Dim rs As Recordset $ U9 j% \" l. u8 s, P: k
Dim RowNum As Integer ; b# [( X: Q( l' s) {
Set work = DBEngine.Workspaces(0)
* p0 k6 B. s2 t/ I7 a# U4 ~3 L; ?Dim dbs As Database
4 Q# ?, k) y- C9 Q- K* ~% A! oDim tdfNew As TableDef ' u! F: q5 E; S1 v& c) i
Dim tdf As TableDef
8 Q2 ^# Q  {/ l. kDim dbsname As String   [! h0 T, N: b
Dim array1 As Variant ; c5 D0 p* k9 `4 ]. P5 \
Dim array2 As Variant ‘声明所需的变量及类型 , a% @9 g$ j9 H4 C! ~
dbsname = “D:\材料表.mdb”
$ e1 o3 @; ?& |‘声明Access数据库写到哪一个文件 ' p; D9 k1 Y. U
On Error Resume Next
( ?% @% z  N3 w' ?$ ~/ WSet dbs = work.CreateDatabase(dbsname, _
% S1 E3 O! m" O$ K: p2 @6 m( UdbLangGeneral) 0 y& O/ k$ p' a0 j9 M# ?
If Err Then
+ k. }8 s) P. iKill (dbsname) ; X" O( l2 r6 R8 O; ^) q
‘发现要写入的Access数据库文件已存在就将其删除 % X! u6 ?" h3 g0 F7 ]& p6 B
Set dbs = work.CreateDatabase(dbsname, _
8 I. Z( F8 O) L9 E; R( jdbLangGeneral) 3 i% w* @; m5 \5 X1 k7 O, H7 x
End If
  L# e, O. G2 z4 W/ O. JSet tdfNew = dbs.CreateTableDef
) a0 u3 ~) S$ G; E* N9 z* c(“电气 _材料明细表”)
; I: g2 f" ]( a5 J% |‘建立一个名为电气材料明细表的表
+ a; U* p5 g; ~; p! W! [RowNum = 0
! _# g# T; l5 i* v2 e9 K) rDim Header As Boolean
$ q9 N( a3 g2 C5 U; K% e+ j7 S3 OHeader = False
% W$ t2 z; b9 VFor Each elem In ThisDrawing.ModelSpace * j: h; L2 U$ H+ y
‘在CAD模型空间,查找所有图形对象 " ?# F9 N$ `& \2 }* r
With elem 3 _# V+ m, Z+ H  Y& R7 q
If StrComp(.EntityName,_ 9 U3 r5 E- N* A' P6 f% M8 P+ }7 ]
“AcDbBlockReference”, 1) = 0 Then
( r+ _* @+ b" E5 X. J) y  fIf .HasAttributes Then . {. i6 X6 }# B
array1 = .GetAttributes ( P% H/ G2 x# }( @( e) _
array2 = .GetConstantAttributes - R  \2 V5 x4 E# W9 c7 Z
‘设置array1指向图形对象的属性
5 B' q4 ~0 w& h' z, H' Z‘设置array2指向图形对象的固定属性
9 C: D  O& g+ e7 U# \8 RFor Count = LBound(array2) To _ : T- n8 ^+ D# `$ B4 J
UBound(array2) " T- S! e% q9 U- `
If Header = False Then
# c% ^: B6 R5 E6 @4 lIf StrComp(array2(Count).EntityName, _ 0 `. x% h7 c( l% L
“AcDbAttributeDefinition”, 1) = 0 Then 4 w. v4 k- w: a* e: n8 h
tdfNew.Fields.AppendtdfNew._
  F% w, M, }' Y, S3 }CreateField(array2(Count).TagString, dbText) $ d4 v- E  O3 u5 h  d
End If
. Y; y( C1 M' l‘读出属性值读出,作为Access数据库表的标题
5 y, l, W, ~* Q3 s- u( c# _  yEnd If 4 _3 W2 U( k+ L7 a2 F( ?3 x
Next Count # L7 @3 _7 m& u/ H
For Count = LBound(array1) To _   @' F/ L& p. X& [3 P. y
UBound(array1)
! ]0 v0 ]! o6 i( eIf Header = False Then
) Z) \. y$ H6 P0 DIf StrComp(array1(Count).EntityName, _
0 r4 L, w& c4 p“AcDbAttribute”, 1) = 0 Then
/ F9 v; A- F' ]6 f! ptdfNew.Fields.Append tdfNew. _
( a7 ~" y% C' Q8 N- K) U+ `CreateField(array1(Count).TagString, dbText)
% [5 F- {" C7 w* j) p: HEnd If
( ^6 G  |! Q& t7 x& x0 ^End If 5 B. U$ `7 ]# a% b$ H
Next Count . Y# u, q' Y! \8 I- e9 r3 y. ^
If Header = False Then
) E0 s8 S; q- d* O; ~( Ddbs.TableDefs.Append tdfNew
% X6 Y; E, G9 D( h" c! r' iSet rs = dbs.OpenRecordset
3 D4 M2 g* C& X3 [+ b(“电气材料 _明细表”, dbOpenTable) ‘打开记录
# ^  n' L" H, rEnd If
7 h4 k; o0 C. |RowNum = RowNum + 1
1 m" R& ?; ]+ |rs.AddNew ‘增加一笔新记录
' k# g8 P5 c& i: ]$ cFor Count = LBound(array2) _
2 t9 U5 Z" W# [% tTo UBound(array2) $ L# o$ U, X" X2 Q$ G* a3 v
rs(Count).Value = array2(Count).TextString 1 D! F- R- |, X3 o
Next Count ‘读固定属性值
; g# ]4 `# M2 G% J+ G& x+ D- HFor Count = LBound(array1) To _ . Q8 m/ L2 U$ V1 t% d
UBound(array1) 1 @/ S* F. S9 V$ R
rs(UBound(array2) + Count + 1).Value = _
/ n3 p6 f+ C$ b8 w+ r& X- farray1(Count).TextString
: d, W# S- s: y$ P/ J  n5 yNext Count ‘读输入属性值
% A- m4 p; k" X1 Ers.Update ‘增加新记录修改结束
2 l+ h; z7 \4 e0 jHeader = True ( H9 P/ ?3 o/ K+ S$ N
End If # `* Z. K. ?" Z) ~) s! b& g
End If ( D/ R- q( A- w, Q+ l
End With , x8 c* O5 k" _5 d( ^% g2 h
Next elem   R& Q! m: V/ p+ \; J* O/ V6 m
rs. Close ‘关闭记录,释放资源 5 C9 `* C! P# E
dbs.Close ‘关闭数据库,释放资源 - v6 u) g1 ^1 @  @3 B" G
End Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot
9 L7 l  A) w4 F! E" D# z真是太好了
4 y0 w( T9 q: Q; Y, I這就是我要的 ^^
发表于 2010-5-11 23:13 | 显示全部楼层
好用吗?有谁下载了?
发表于 2010-8-24 19:08 | 显示全部楼层
学习学习!
发表于 2010-10-25 14:37 | 显示全部楼层
先看看看再说
发表于 2011-2-21 05:48 | 显示全部楼层
下来看看先,谢谢了。
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

关于|免责|隐私|版权|广告|联系|手机版|CAD设计论坛

GMT+8, 2025-12-29 18:42

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

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

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