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() % x& p7 R, C5 U1 y8 M; l' P! [. j+ [6 v
Dim work As Workspace
/ q) J4 W- t  M& L% o. mDim new As Database " Y7 V  F: n& t$ P5 s- Z4 h
Dim elem As Object
7 [! X2 T3 `$ C' I3 T4 TDim rs As Recordset
5 ^3 M7 i% d& o7 ZDim RowNum As Integer " Q; _( P, }8 g. ^
Set work = DBEngine.Workspaces(0)
% y  U/ ]+ q2 `. UDim dbs As Database
' H# p. D( M9 K4 EDim tdfNew As TableDef
& F! _* Y1 G/ f, q2 O. u( ~Dim tdf As TableDef
; e. N# `8 F. t6 u6 l8 _" MDim dbsname As String
6 D# T- K8 M  l" nDim array1 As Variant
% w) I4 \2 T8 hDim array2 As Variant ‘声明所需的变量及类型 . Z  a( u. _( L
dbsname = “D:\材料表.mdb” : u1 p  d4 c+ H9 w
‘声明Access数据库写到哪一个文件
2 n6 \! i* J1 [. ?) G( lOn Error Resume Next
3 d8 R" o" P; m1 i) O+ U1 r$ `- NSet dbs = work.CreateDatabase(dbsname, _
+ L: `: n) L$ U" s" `; t* {dbLangGeneral) ! H- w/ u4 {: m6 `2 f+ v# z
If Err Then
! n! N0 a' Q! B. @; LKill (dbsname) ; O) I7 `( i. y  T
‘发现要写入的Access数据库文件已存在就将其删除 * Z/ T" k+ F6 q! b3 a& Z/ b% {2 u
Set dbs = work.CreateDatabase(dbsname, _
% j8 `4 X0 A: H8 E% v9 `2 H7 WdbLangGeneral) $ h9 ^$ ?4 w/ m3 i- K
End If " X( P% c' x" h6 {9 N# e
Set tdfNew = dbs.CreateTableDef ; G( E+ W- }% c/ Z
(“电气 _材料明细表”)
( @4 p. Z( T  J" {# h! a. E9 ~‘建立一个名为电气材料明细表的表
& n# A* I' K  [  iRowNum = 0 " S3 \( F+ h: P0 D" v) I
Dim Header As Boolean 6 ?6 `" M# L' j
Header = False 2 l6 {0 G3 [( P
For Each elem In ThisDrawing.ModelSpace $ U, d8 u' m+ a8 ~* t3 s
‘在CAD模型空间,查找所有图形对象
! r$ Z4 a5 d  o7 U* I$ oWith elem
0 w/ n  ^8 Y, G. ]- WIf StrComp(.EntityName,_ + k" ?9 }$ d& r
“AcDbBlockReference”, 1) = 0 Then
( f2 P5 j+ |' i, \9 c7 `If .HasAttributes Then
& O9 `9 {" n+ c  farray1 = .GetAttributes $ ]  ?& B  [- b5 O
array2 = .GetConstantAttributes
% T' n% i/ n4 e3 i‘设置array1指向图形对象的属性 0 `% _$ w, w, J, z1 d0 }
‘设置array2指向图形对象的固定属性 . I9 c$ Y" D; H: t& C0 ~4 f9 |
For Count = LBound(array2) To _
8 j* Q0 g5 A: V5 YUBound(array2) 3 a5 a/ O# W  T+ M: U# ~
If Header = False Then 9 M: o/ S' |: [! d
If StrComp(array2(Count).EntityName, _ 9 W6 N9 Y* z" P/ K. O
“AcDbAttributeDefinition”, 1) = 0 Then / c. c+ T2 r5 z9 Y+ M
tdfNew.Fields.AppendtdfNew._ / g% _- T3 i. q2 H+ }/ r7 {# m
CreateField(array2(Count).TagString, dbText) ' V; O. D& |8 W2 R5 S
End If
7 h6 V: U2 ^" o‘读出属性值读出,作为Access数据库表的标题 7 w, `3 K) @2 c- W, z
End If
# F" v. x/ i1 _; L: \Next Count # A$ c  h# f2 j* g
For Count = LBound(array1) To _
+ i! T8 G7 Z+ f. \UBound(array1)
  d5 f; n: |9 B9 ^If Header = False Then 7 ?2 m% U5 C! n1 p2 I
If StrComp(array1(Count).EntityName, _
) ]* K5 ^% G, }1 X7 V; ~9 x“AcDbAttribute”, 1) = 0 Then
/ @# W; w  t$ P1 p* m) L* a: }tdfNew.Fields.Append tdfNew. _
3 n* T: k' m( d5 C7 vCreateField(array1(Count).TagString, dbText) * [; F6 X' G. A5 @+ ^
End If
7 v% J3 `- q' z: X2 P5 mEnd If
0 F* n( X3 F/ W$ ^$ A6 P7 pNext Count - x$ f* a/ X. I( i9 F. G" _
If Header = False Then
2 H5 c1 w$ e! \0 x2 s/ c) xdbs.TableDefs.Append tdfNew , Q  d7 [3 r/ b( U) v
Set rs = dbs.OpenRecordset
- d1 G! H- k) N( c; B(“电气材料 _明细表”, dbOpenTable) ‘打开记录 * L. ]) n4 V8 z( L4 ?+ [
End If 6 Q+ x; ^: i- L2 z% k, t: H
RowNum = RowNum + 1 1 z' n1 }/ L- U, ^7 |$ Z' j
rs.AddNew ‘增加一笔新记录
% A/ H% Y: [# m- wFor Count = LBound(array2) _ ' t- B  A) f7 x, X1 }& p
To UBound(array2) 9 j0 ]  k5 Y3 s; Z# f
rs(Count).Value = array2(Count).TextString
5 P0 B  P$ }6 y' t- ?  ?9 wNext Count ‘读固定属性值
# ?8 ?- i# E; J7 q$ _4 KFor Count = LBound(array1) To _
2 ^" a2 T/ j- Z6 x# F9 F  vUBound(array1) 5 I/ G8 W& V& S: T" N2 M
rs(UBound(array2) + Count + 1).Value = _
0 v# T6 p- V  c/ M+ @array1(Count).TextString
" N( X& r. C. W4 L+ TNext Count ‘读输入属性值 5 ]( S( M. {- {0 M  |  H
rs.Update ‘增加新记录修改结束
4 F2 }  i/ }# S# _/ f& ?' ~4 i" L" MHeader = True
6 f" b# q: W8 sEnd If
; \1 L2 _3 C5 T8 Z7 W0 t) CEnd If
' k2 d9 |# I; O! REnd With
3 K3 J0 w7 m7 h, N. DNext elem , X- t, S! e2 q7 n( T$ b, Z2 K, N
rs. Close ‘关闭记录,释放资源 1 }  p) \- _) _" _! ?1 X' A$ X
dbs.Close ‘关闭数据库,释放资源 ; i6 }1 m6 r* C. v# d1 j& Z3 m
End Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot
# C8 \. D. _: e5 @# D真是太好了
+ b2 Q+ ?1 G$ q- m3 n這就是我要的 ^^
发表于 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-10 08:17

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

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

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