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()
  h1 `7 S. a  ?: Y8 ~Dim work As Workspace # |8 t0 S; m! Z* Y6 h' v( W
Dim new As Database , C- g9 Q/ I. N# O) {% N1 B+ L  Q
Dim elem As Object ' h# h. t' a$ C/ C
Dim rs As Recordset 3 k& j" Y% U; h5 @- g
Dim RowNum As Integer $ y; c+ `, H+ D
Set work = DBEngine.Workspaces(0)
" {; o6 g! ~5 ~4 {# b7 VDim dbs As Database
% H* U# F$ e6 p' Z; ZDim tdfNew As TableDef 9 z9 |" @. E# W3 ~# f
Dim tdf As TableDef * Z8 I0 |  c( y* N( K7 R) F+ N
Dim dbsname As String
6 c, X, _/ A/ E( A6 jDim array1 As Variant 7 I; {5 h6 K* Z& d1 D7 {4 A$ F
Dim array2 As Variant ‘声明所需的变量及类型
  P4 i9 y; a9 v/ T" S; g& y0 bdbsname = “D:\材料表.mdb” & \( |4 Z/ m. i- p
‘声明Access数据库写到哪一个文件 6 S( w: S* B8 T$ Q
On Error Resume Next
0 i6 x- M% ]0 DSet dbs = work.CreateDatabase(dbsname, _ * u5 C( Z2 H# h$ c& Q2 p
dbLangGeneral) 0 N9 E" D- Z+ W3 H0 Y5 V. J) ?
If Err Then ( V) w; p. L. O! i! W$ r7 V4 H
Kill (dbsname)
7 g. U  i0 ^" w8 M- x‘发现要写入的Access数据库文件已存在就将其删除
  ~8 p* n, P; k4 kSet dbs = work.CreateDatabase(dbsname, _ 4 o1 O# E# a; [: \, t. l: P9 C9 P
dbLangGeneral) " X! d' m: J2 \, _4 h. A/ v, \
End If
! Z- L* ?; l+ WSet tdfNew = dbs.CreateTableDef 1 C) N/ \% r* R
(“电气 _材料明细表”)
  n5 J. x1 ?' B7 G/ u‘建立一个名为电气材料明细表的表
% Z1 w" p7 H) R0 mRowNum = 0 ; o( g2 {2 ?; B6 [( ~& y; p
Dim Header As Boolean 7 q& p" U" w( L
Header = False ' H4 a5 N- \# i( a# @
For Each elem In ThisDrawing.ModelSpace , T3 u4 Z' A- g4 B" W
‘在CAD模型空间,查找所有图形对象
4 J$ w* t% V& G+ Q3 lWith elem + e, j2 z9 `+ T
If StrComp(.EntityName,_ , t1 _- l9 s* h, W4 M! {
“AcDbBlockReference”, 1) = 0 Then
9 m: E3 q  w1 j; R4 G) PIf .HasAttributes Then
, C" x+ ]( `$ _0 N7 n, ?  Xarray1 = .GetAttributes # F, @' q! _; {7 o3 I; ^5 R% y# L
array2 = .GetConstantAttributes & y+ V$ v: A2 I8 X# j  Q
‘设置array1指向图形对象的属性
1 M1 I$ J6 ~& W  u: i% ]‘设置array2指向图形对象的固定属性
1 j/ M' |$ o# S! \' iFor Count = LBound(array2) To _ , X+ v6 Y6 G  x- E  Y7 Y/ Y
UBound(array2)
# R- q" ^: `! u; {. ?2 r% [/ gIf Header = False Then % X/ W- _9 a; L+ _' ^: \9 u
If StrComp(array2(Count).EntityName, _   B/ s+ N/ {- a8 N1 S0 n, u  ~
“AcDbAttributeDefinition”, 1) = 0 Then 1 N  [4 [% x  Z/ d% S
tdfNew.Fields.AppendtdfNew._
: H0 h% A1 Q5 S. w, s# ?CreateField(array2(Count).TagString, dbText)
9 G( O- @! \& Z3 YEnd If
& k4 R% N% k6 c; ^* Z: y( ^, X4 n‘读出属性值读出,作为Access数据库表的标题
8 m- f8 A( C( v* pEnd If * u! Z. [9 j- d/ B; @* }
Next Count
/ c% e+ r6 ^8 k0 L: f% ?3 d; J! YFor Count = LBound(array1) To _
9 E; @  h% y; k1 g7 {7 j& I" O6 `1 j7 xUBound(array1)
0 e+ w5 M5 P7 m: |0 AIf Header = False Then
  O7 a! E( P( h" EIf StrComp(array1(Count).EntityName, _   G- [% C$ J6 D9 A/ N* V! |$ o8 y
“AcDbAttribute”, 1) = 0 Then 4 w. M1 Q' W) `
tdfNew.Fields.Append tdfNew. _ 1 a" A' ?! r9 \$ q
CreateField(array1(Count).TagString, dbText)
6 q- H( K# t% G1 S9 g- X3 i# cEnd If
9 U( h! O5 `0 u/ }3 Q3 _End If
' Y2 c0 x2 h" B' d; _; |Next Count
# V, J  D4 _+ N1 R+ L2 U4 I- dIf Header = False Then
8 g0 u+ a" z% t9 Z' T+ ~2 Ddbs.TableDefs.Append tdfNew 4 h8 K4 X0 U) A. F! k* X
Set rs = dbs.OpenRecordset . e# ^& {- n# J( _* V
(“电气材料 _明细表”, dbOpenTable) ‘打开记录
% v8 I1 F( o3 _: B9 g$ bEnd If
/ i, t3 O' @& V. sRowNum = RowNum + 1
" V3 k& C, L$ E" k0 c% u6 yrs.AddNew ‘增加一笔新记录
: L! H& [6 e9 C, Z. OFor Count = LBound(array2) _
: @$ j3 i% ~! `, M1 a8 A2 ^To UBound(array2)
; D4 Y' k3 C' N; Q8 i' c) ers(Count).Value = array2(Count).TextString
3 I* S  P2 c5 Q# sNext Count ‘读固定属性值 & w6 C# r8 P; w8 ~  _
For Count = LBound(array1) To _ ( ~- H- ]/ @" Z
UBound(array1) ! d3 a) R# D! b1 o1 `
rs(UBound(array2) + Count + 1).Value = _
. q% w: R  r5 F0 ^array1(Count).TextString ) H4 Y7 F- A, Y3 x# r. u1 L# w
Next Count ‘读输入属性值
% {+ M7 ^3 F8 |2 P* T; z( M5 `rs.Update ‘增加新记录修改结束
8 Y- A- d3 b: J& wHeader = True
1 V( I7 @& `! T" \0 S$ ]End If
  r$ F. ~2 q% K- s, S/ zEnd If
/ i+ E8 q( l" e( {: v  `1 e, H+ xEnd With
1 M9 _* O) q. P! a6 |6 W. K( rNext elem
: y3 x/ p5 f6 P0 g0 r6 drs. Close ‘关闭记录,释放资源
0 l2 I  o  N+ p# I( G5 |) @dbs.Close ‘关闭数据库,释放资源 ! W: h0 m7 ~! z: a: }8 h, v0 b  A( m( }
End Sub
发表于 2009-1-6 13:50 | 显示全部楼层
赚钱中
发表于 2009-1-6 21:17 | 显示全部楼层
thank a lot
$ `0 s' q8 G- L$ R8 C真是太好了
. F( \! k+ C; p9 D! V: v' `* s這就是我要的 ^^
发表于 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-16 10:20

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

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

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