XJFA 发表于 2008-10-17 16:08

下载不了了？？？？

XJFA 发表于 2008-10-17 16:10

怎么下载啊，为什么下不了？

jacksonchou 发表于 2008-10-20 15:19

不知道是做什么用的

fighting1983 发表于 2008-12-10 13:25

顶起

请用过的同志说明一下怎么用

abcjeans 发表于 2009-1-6 13:04

Sub list()
Dim work As Workspace
Dim new As Database
Dim elem As Object
Dim rs As Recordset
Dim RowNum As Integer
Set work = DBEngine.Workspaces(0)
Dim dbs As Database
Dim tdfNew As TableDef
Dim tdf As TableDef
Dim dbsname As String
Dim array1 As Variant
Dim array2 As Variant ‘声明所需的变量及类型
dbsname = “D:\材料表.mdb”
‘声明Access数据库写到哪一个文件
On Error Resume Next
Set dbs = work.CreateDatabase(dbsname, _
dbLangGeneral)
If Err Then
Kill (dbsname)
‘发现要写入的Access数据库文件已存在就将其删除
Set dbs = work.CreateDatabase(dbsname, _
dbLangGeneral)
End If
Set tdfNew = dbs.CreateTableDef
(“电气 _材料明细表”)
‘建立一个名为电气材料明细表的表
RowNum = 0
Dim Header As Boolean
Header = False
For Each elem In ThisDrawing.ModelSpace
‘在CAD模型空间，查找所有图形对象
With elem
If StrComp(.EntityName,_
“AcDbBlockReference”, 1) = 0 Then
If .HasAttributes Then
array1 = .GetAttributes
array2 = .GetConstantAttributes
‘设置array1指向图形对象的属性
‘设置array2指向图形对象的固定属性
For Count = LBound(array2) To _
UBound(array2)
If Header = False Then
If StrComp(array2(Count).EntityName, _
“AcDbAttributeDefinition”, 1) = 0 Then
tdfNew.Fields.AppendtdfNew._
CreateField(array2(Count).TagString, dbText)
End If
‘读出属性值读出,作为Access数据库表的标题
End If
Next Count
For Count = LBound(array1) To _
UBound(array1)
If Header = False Then
If StrComp(array1(Count).EntityName, _
“AcDbAttribute”, 1) = 0 Then
tdfNew.Fields.Append tdfNew. _
CreateField(array1(Count).TagString, dbText)
End If
End If
Next Count
If Header = False Then
dbs.TableDefs.Append tdfNew
Set rs = dbs.OpenRecordset
(“电气材料 _明细表”, dbOpenTable) ‘打开记录
End If
RowNum = RowNum + 1
rs.AddNew ‘增加一笔新记录
For Count = LBound(array2) _
To UBound(array2)
rs(Count).Value = array2(Count).TextString
Next Count ‘读固定属性值
For Count = LBound(array1) To _
UBound(array1)
rs(UBound(array2) + Count + 1).Value = _
array1(Count).TextString
Next Count ‘读输入属性值
rs.Update ‘增加新记录修改结束
Header = True
End If
End If
End With
Next elem
rs. Close ‘关闭记录，释放资源
dbs.Close ‘关闭数据库，释放资源
End Sub

abcjeans 发表于 2009-1-6 13:50

赚钱中:'( :'( :'(

is720714 发表于 2009-1-6 21:17

thank a lot
真是太好了
這就是我要的 ^^

YOUNGXIAOWEI 发表于 2010-5-11 23:13

好用吗？有谁下载了？

yanming030 发表于 2010-8-24 19:08

学习学习！

aidingdanli 发表于 2010-10-25 14:37

先看看看再说

yaojia001x 发表于 2011-2-21 05:48

下来看看先，谢谢了。
页: 1 [2]
查看完整版本: cad统计材料表