从Excel使用AutoCad的ObjectDBX
好的,我在autolisps中回复了几次关于使用Objtdbx获取属性的线程,这非常有用。现在我有一个VBA问题,我知道有一个方法,但还没有花足够的时间在上面,如何从excel的vba中运行odbx???我想避免一起使用AutoCad编码。这是我试图在excel中创建的内容的大纲:拉起浏览器选择一些绘图
开始OBDX
从每个文件中提取一些属性,每个布局
将每个属性放在excel文件中。
有什么建议吗?
任何链接或示例?
我是这方面的新手,但有了一些解释,我就明白了。
谢谢,
维克多。
**** Hidden Message ***** 好吧,首先你必须有A。Autcad running, B.)已安装 Autocad,因此可以启动它,C.)从Autodesk购买了ObjectDBX的独立版本(现在称为RealDWG)。与Acad一起发布的版本是免费使用的,但需要运行Acad的实例。虽然它可能是不可见的,所以用户永远不会看到它....
我最近刚刚做了一个例子,让我看看是否能找到它。
编辑。。。。嗯,我似乎在家用电脑上,我把笔记本电脑留在了办公室。除非我可以访问我发布它的地方,否则它必须等待,这可能需要一段时间,因为我不记得我
在哪里
使用它。 好吧,我想我弄清楚了...是维克多,我提出要帮助Adesk新闻组。他从来没有回应过细节,所以我从来没有完成我的例子.....难怪我不记得我在哪里发布它,我从来没有做过。
所以,维克多,我要重申我之前说过的话。在Excel中访问Acad / ODBX所需的大部分内容都在Acad提供的示例中。至于浏览文件夹/dwgs,周围有很多例子。我很确定你会在沼泽中找到一些,但这是一个典型的VBA代码,可以从许多VBA源中提取。
如果明天这里和今天一样潮湿,我应该有一些时间把东西放在一起,如果你还没有这样做的话。 没关系,维克多....不管怎样,我宁愿在这里帮助你
我昨天没有发这个帖子,因为我得到了一些坏消息,我不得不叫醒我的妻子,匆忙离开。由于我岳母昨天去世了,我不确定下周我会有多少时间,因为我们会去纽约旅行.......
无论如何,以下是我要展示的如何使用ObjectDBX从Excel访问绘图。我没有时间添加到文件夹搜索或其他任何东西....即,这被设置为1绘图类型访问....应该一次创建acad/objectdbx对象,而不是每次访问图形时都创建。祝你好运,希望其他人能来帮忙。
'Excel Code!
'Modified April 1, 2006 by Jeff Mishler to demonstrate the use of ObjectDBX.
' ActiveX Sample
'
' Copyright (C) 1997, 1999, 2002 by Autodesk, Inc.
'
' Permission to use, copy, modify, and distribute this software
' for any purpose and without fee is hereby granted, provided
' that the above copyright notice appears in all copies and
' that both that copyright notice and the limited warranty and
' restricted rights notice below appear in all supporting
' documentation.
'
' AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
' AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
' MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.AUTODESK, INC.
' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
' UNINTERRUPTED OR ERROR FREE.
'
' Use, duplication, or disclosure by the U.S. Government is subject to
' restrictions set forth in FAR 52.227-19 (Commercial Computer
' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
' (Rights in Technical Data and Computer Software), as applicable.
Option Explicit
Sub Extract()
Dim sheet As Object
Dim elem As Object
Dim excel As Object
Dim excelSheet As Object
Dim RowNum As Integer
Dim Array1 As Variant
Dim Count As Integer
Dim acad As Object
Dim doc As Object
Dim mSpace As Object
Dim NumberOfAttributes As Integer
Dim AcadRunning As Boolean
Set excel = GetObject(, "Excel.Application")
Worksheets("Attributes").Activate
Set excelSheet = excel.ActiveWorkbook.Sheets("Attributes")
excelSheet.Range(Cells(1, 1), Cells(1000, 100)).Clear
excelSheet.Range(Cells(1, 1), Cells(1, 100)).Font.Bold = True
Set acad = Nothing
On Error Resume Next
Set acad = GetObject(, "AutoCAD.Application")
If Err0 Then
Set acad = CreateObject("AutoCAD.Application")
acad.Visible = False
AcadRunning = False
'MsgBox "Please open a drawing file and then restart this macro."
'Exit Sub
Else
AcadRunning = True
End If
On Error GoTo 0 'Err_Handler
If acad.Version Like "16*" Then
Set doc = acad.getinterfaceobject("ObjectDBX.AxDbDocument.16")
ElseIf acad.Version Like "17*" Then
Set doc = acad.getinterfaceobject("ObjectDBX.AxDbDocument.17")
Else
Set doc = acad.getinterfaceobject("ObjectDBX.AxDbDocument")
End If
doc.Open "C:\Temp\Att-Test.dwg"
RowNum = 1
Dim Header As Boolean
Header = False
Dim oBlock As Object
Dim oLayout As Object
For Each oLayout In doc.Layouts
If oLayout.Name"Model" Then
Set oBlock = oLayout.block
For Each elem In oBlock
With elem
If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
If UCase(.Name) = "TDG" Then
If .HasAttributes Then
Array1 = .GetAttributes
For Count = LBound(Array1) To UBound(Array1)
If Header = False Then
If StrComp(Array1(Count).EntityName, "AcDbAttribute", 1) = 0 Then
excelSheet.Cells(RowNum, Count + 1).Value = Array1(Count).TagString
End If
End If
Next Count
RowNum = RowNum + 1
For Count = LBound(Array1) To UBound(Array1)
excelSheet.Cells(RowNum, Count + 1).Value = Array1(Count).TextString
Next Count
Header = True
End If
End If
End If
End With
Next elem
End If
Next oLayout
NumberOfAttributes = RowNum - 1
If NumberOfAttributes > 0 Then
Worksheets("Attributes").Range("A1").Sort _
key1:=Worksheets("Attributes").Columns("A"), _
Header:=xlGuess
Else
MsgBox "No attributes found in the current drawing."
End If
Set doc = Nothing
If AcadRunning = False Then acad.Quit
Set acad = Nothing
Exit Sub
Err_Handler:
Debug.Print Err.Number & " - " & Err.Description
Err.Clear
If AcadRunning = False Then acad.Quit
End Sub
听到你岳母杰夫的事我很难过。代我拥抱你妻子。 杰夫,我也很高兴听到这个消息。 如果你不是绝对需要一个代码解决方案,我相信从AutoCAD 2004开始,你可以使用‘高级属性提取’(只需在命令行输入EATTEXT)。
它将允许您选择多个图形文件,并从要导出的块中选择块和属性。如果机器上有EXCEL,您将可以选择直接保存到EXCEL文件。干杯,格伦。 杰夫,非常感谢你的回复,我很抱歉听到你的损失,不要担心我在这里,如果我没有得到答案,我有耐心帮助我。
Glenn,实际上eattext很糟糕,我不相信adesk想出了一个完整的套路。它不适用于多个绘图,它只能部分工作,但不能正常工作。在adesk论坛上有讨论这个问题的帖子,但是还没有发布解决方案。这将允许我实际使用我自己的电子表格,并填写我想要的单元格,而不仅仅是一个新的电子表格。
再次感谢,我会试一试代码。维克多。 好的,所以我一直在四处寻找,需要某人的一点帮助...
通过vba
从绘图中获取东西有什么区别或
从绘图中获取东西VIA OBDX&VBA???
我主要是说由autodesk提供并发布在上面的示例。所以这与在AutoCad中使用VBA是一样的,你不能有选择集,也不必打开绘图,对吗?(autocad正在运行,但绘图不必打开)那么为什么示例仍然希望打开该绘图?
是的,我有点困惑。有人给我一些教程或其他东西的链接。
谢谢,
Viktor。 示例中的open与open是不同的。把它想象成更像是在记事本中打开一个dxf文件。你可以在文本中找到图中的所有信息(我不太清楚odbx是如何工作的)。你可以用vba在cad中打开10个dwg,你可以在屏幕上看到每个DWG闪烁,你也可以在odbx中打开10个DWG,你什么也看不到。速度更快,在后台运行。
页:
[1]
2