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()
4 N5 o. J$ Z/ }6 c" ^- dDim work As Workspace
6 G+ @$ _  K. ?' x* ]' {# p# k; DDim new As Database
+ a9 d$ P+ [0 D' Q" y  v0 i! `0 \3 BDim elem As Object
! F$ A" x- Y% g4 oDim rs As Recordset
8 f* P4 ]/ @+ \! `3 oDim RowNum As Integer
; H8 q: t/ ]. j  OSet work = DBEngine.Workspaces(0)
3 F6 w/ ~; p: w4 {, G5 g6 q+ U2 UDim dbs As Database
5 w) \- d9 \" ?+ ^Dim tdfNew As TableDef 3 ]" ]3 B) L' _3 ~; C/ O2 L7 V
Dim tdf As TableDef ' u$ Z& z' q+ b7 V- h8 y
Dim dbsname As String
( C. f8 z; Y  ?Dim array1 As Variant   h. l0 O+ Z% ^5 Q& X
Dim array2 As Variant ‘声明所需的变量及类型
0 V$ J2 i4 e3 I. wdbsname = “D:\材料表.mdb”
9 S* L6 K" [# e3 G; |% R8 @‘声明Access数据库写到哪一个文件 0 l" {& p: k' F+ i: I! j! _
On Error Resume Next ; I6 k* \! F0 v  u( ]3 H( D, [
Set dbs = work.CreateDatabase(dbsname, _
$ X- c8 E' v$ r) c3 j7 N5 e, n! P3 rdbLangGeneral)
. d- U  V8 w  D) c% nIf Err Then
& T/ K+ Z1 D# L+ R9 O/ g% hKill (dbsname)
$ R" }' Z% v+ m9 G1 {% H‘发现要写入的Access数据库文件已存在就将其删除
# ~; D: O  N# DSet dbs = work.CreateDatabase(dbsname, _
$ Y9 a# d- Z  e$ ^9 `1 rdbLangGeneral) , p* q4 I2 Q% F! L% I# n: C
End If
; j7 s& L6 t  d; P& MSet tdfNew = dbs.CreateTableDef
6 `0 x! _" h# E. _. L* ]- y(“电气 _材料明细表”) 7 b* @9 o+ t- H
‘建立一个名为电气材料明细表的表
& O, f" k# f3 |; }& B) ARowNum = 0
7 R1 B% z; @6 eDim Header As Boolean ; j4 M8 H* C0 U! z) s  y! W
Header = False 8 K" m2 p) {9 h
For Each elem In ThisDrawing.ModelSpace
, e2 h* _$ L' b9 h+ N" _7 y‘在CAD模型空间,查找所有图形对象
% N/ Z0 E* V- ~" j: x" aWith elem 5 H1 t1 X) K2 x8 \$ p
If StrComp(.EntityName,_ ' ~) {' v, G9 @& p
“AcDbBlockReference”, 1) = 0 Then . A4 G8 h- ?; ?7 b
If .HasAttributes Then - L8 z& F  g8 M: z0 {
array1 = .GetAttributes
$ ]! e- Q1 j/ _  parray2 = .GetConstantAttributes / F" v4 n: ^* n+ {8 _; W
‘设置array1指向图形对象的属性
+ A: R( @; E3 w: u; {‘设置array2指向图形对象的固定属性
3 ~. C3 G' B- O+ [For Count = LBound(array2) To _ - ^( [, D3 t* Y: ?
UBound(array2)
. j# _+ X; \* w1 bIf Header = False Then & d: T8 ]. n" S( X& }
If StrComp(array2(Count).EntityName, _ $ F" K$ Y9 a- e$ f/ a7 h
“AcDbAttributeDefinition”, 1) = 0 Then   D8 Z( {7 `' `- y
tdfNew.Fields.AppendtdfNew._
5 t6 \5 J- c: O; {  R3 NCreateField(array2(Count).TagString, dbText)
9 X4 F' U4 o0 LEnd If : Y9 \; `8 F' X+ L% `" v  Q
‘读出属性值读出,作为Access数据库表的标题
) ~# L7 b  b' _4 {4 NEnd If
& Y  @. p. o8 h/ g7 j4 M# l1 N$ |6 WNext Count 1 q5 F6 \5 x( |2 U- ?# Y2 C, H5 \
For Count = LBound(array1) To _
( G1 m, _! S. B2 lUBound(array1)
0 |4 m0 o6 X, |6 A' I3 C4 G* e- X# bIf Header = False Then
6 }( }, H! `6 O( M% R: A+ r1 CIf StrComp(array1(Count).EntityName, _
2 A4 K7 Z" T& D& C5 u“AcDbAttribute”, 1) = 0 Then 8 }! s- k5 K2 z5 B8 r$ D
tdfNew.Fields.Append tdfNew. _
& G) B% x& I0 d2 ACreateField(array1(Count).TagString, dbText) 6 w, T. @2 w* d6 ~5 X' g
End If
0 ^8 y; @: w4 E$ \End If
7 g+ V( F) |- p' DNext Count ( k7 I4 q- c' x; h# Z- j" h* t
If Header = False Then " _- h2 }: c" ]! l$ V/ @' R
dbs.TableDefs.Append tdfNew
* F" D5 `1 h; |* x! |* ASet rs = dbs.OpenRecordset 1 Y( V6 \, q5 i) F/ y1 m# u6 G9 q
(“电气材料 _明细表”, dbOpenTable) ‘打开记录
2 U3 E  B# d0 ~) ZEnd If
% J$ H% A; T7 w5 ], [; D# ^RowNum = RowNum + 1 ' D$ j8 W2 J9 a
rs.AddNew ‘增加一笔新记录
9 O1 A; T( g. z! }8 k) c# TFor Count = LBound(array2) _ 7 }+ T+ {* j; f, d* ~% A2 N( ?; E
To UBound(array2) ; p# Y! z6 W( o
rs(Count).Value = array2(Count).TextString & w/ N- m7 G9 S3 F9 `6 d5 B% r' X
Next Count ‘读固定属性值
# h, Z" p3 d$ b8 XFor Count = LBound(array1) To _ $ O7 s2 {, n+ R
UBound(array1) ; V" W1 I5 `' H, w( T. \' N" N
rs(UBound(array2) + Count + 1).Value = _
) F% a' ^7 h! [7 ]. l% D' Darray1(Count).TextString   J/ m9 T) o, c# N" {
Next Count ‘读输入属性值
7 m' ~4 P" S7 r8 h9 P. trs.Update ‘增加新记录修改结束 , L7 V, Q  E" P* s
Header = True
+ a) \8 v: e$ MEnd If
; C4 F- e4 m5 p0 ^5 `7 x! EEnd If
# a4 M- y- j9 w5 [2 tEnd With
4 y! e4 A/ _5 dNext elem
  [& M0 [0 E' krs. Close ‘关闭记录,释放资源
* X0 f. W" d* k; U3 }* i$ y+ x* [9 Udbs.Close ‘关闭数据库,释放资源
6 n) \: O9 \( g% A# H- A6 a  O- r. s3 KEnd Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot
" B. R. J$ D* B8 m! x; W& x真是太好了
8 z& z( E/ e* @這就是我要的 ^^
发表于 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-18 12:14

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

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

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