从mul导出属性数据
大家好，自2007年以来，我一直使用一种工具，可以将所有属性数据导出到excel，调整数据并将其更新回Autocad。
这一切都是通过VBA完成的。
不幸的是，代码从未被更新，现在它不再工作了。
我经常使用这个工具，我真的希望它能再次工作。
或者类似的事情。
工作流程应如下所示：
-运行命令（将块信息导出到excel）
（在后台打开excel）
-选择块
-如果存在块，程序将检查所有图形（在autocad会话中打开的图形）。
-然后将所有属性信息导出到Excel。
第二个程序将更新所有打开图形中的所有属性。
谁能帮我？？？
当做
卫斯理 由于新版本的AutoCAD默认不再支持VBA，因此您的工具可能停止工作；但是，您可以从Autodesk下载启用程序扩展。 我的所有版本都安装了vba enabler。
不知怎的，它已经不起作用了。
在Acad2014中，32位代码不再是wokring。
我不是vba程序员，所以我找不到问题。 它是开放代码还是已编译？如果编译，那么尝试在64位中运行可能是个问题。
你有源代码吗？使用Vbaman进行测试可以从命令行a运行DVB使用：^C^C（vl vbaload“S:/VBA/Design Toolkit.DVB”）（vl vbarun“Toolkit”） 我更想知道这是否也可以通过LISP实现。 你好
你看过李的例行公事了吗
http://www.lee-mac.com/macatt.html 这只是一个操作，“调整数据”意味着在更新属性之前在Excel中进行计算？或者是大约两个单独的操作/命令（导出/导入）？
基本上，为了解决最后一个问题，您可以使用AutoLISP提取/编辑属性，还可以通过COM技术访问Excel，因此复制您的工具似乎是可行的。 Macatt只允许我导出属性值。
我想要的是：
-要选择标题栏，
-将所有打开图形的所有属性值导出到excel，
-更新信息（如drawingnumbers-drawingtitles）
-将其重新导入autocad。
@比加尔
我看了vba代码。但它看起来使用了很多不同的部件。 如果你很高兴发布代码，听起来好像它没有编译，那么有人可以试着运行并找到问题。可能比重新开始更简单。如果需要，甚至可以更容易地重写它。 我不知道这是否是全部代码。
这只是其中的一部分。
dvb文件中有大量的小工具。
希望你能用它做点什么。
Public Sub TelAllDocs()
Dim aDocs As Variant, aDoc As AcadDocument
Dim oBlok As AcadBlockReference, Pt
Dim Excel As Object, ExcelSheet As Object
Dim nX
Dim EersteRij() As Variant
Debug.Print
Set Excel = StartExcel
Excel.Visible = True
Excel.Workbooks.Add
Set ExcelSheet = Excel.sheets.Add
ExcelSheet.name = Format(Application.Documents.Count, "00") & "-documenten"
RowNum = 2
EersteRij = Array("Bloknaam", "X", "Y", "Handle", "Layer", "Pad", "Filenaam")
ExcelSheet.Range("A1:BZ1").Font.Bold = True
For nX = LBound(EersteRij) To UBound(EersteRij)
ExcelSheet.cells(1, nX + 1).Value = EersteRij(nX)
Next nX
AppActivate "Autocad", False
DoEvents
On Error Resume Next
ThisDrawing.Utility.GetEntity oBlok, Pt, "Wijs Blok aan : "
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
Set aDocs = Application.Documents
For Each aDoc In aDocs
Debug.Print aDoc.Path; "\"; aDoc.name
aDoc.Activate
TelAttrDoc oBlok.name
Next
Beep
Set Excel = Nothing
Set ExcelSheet = Nothing
End Sub
Private Sub TelAttrDoc(sBlokNaam)
Dim Excel As Object
Dim oBlokje As Object
Dim ExcelSheet As Object
Dim Array1 As Variant
Dim Count
Dim NumberOfAttributes As Integer
Dim FoundAttributes As Boolean
Dim tmp As Integer
Dim oBlokjeReference As AcadBlockReference
Dim sBlokName As String
Dim nKol1, nX, Retval As Double, nTimeout As Byte
Dim EersteRij() As Variant
Dim W9 As AcadSelectionSet
Dim Q4 As cObj
Set Q4 = New cObj
Q4.VoegToeGroepModified BLOK, Left(sBlokNaam, 7) & "*"
Q4.SelType = acSelectAll
Q4.ExcecuteSelect
Set W9 = ThisDrawing.SelectionSets(Q4.SelSetNaam)
Debug.Print W9.Count
If W9.Count = 0 Then Exit Sub
nTagTeller = 0
Set Excel = StartExcel
Set ExcelSheet = Excel.sheets(Format(Application.Documents.Count, "00") & "-documenten")
On Error GoTo 0
EersteRij = Array("", "", "", "", "", "", "")
For Each oBlokje In W9
If oBlokje.HasAttributes Then
Set oBlokjeReference = oBlokje
ExcelSheet.cells(RowNum, 1) = oBlokje.name
ExcelSheet.cells(RowNum, 1).NumberFormat = "@"
ExcelSheet.cells(RowNum, 2).Value = oBlokjeReference.InsertionPoint(0)
ExcelSheet.cells(RowNum, 3).Value = oBlokjeReference.InsertionPoint(1)
ExcelSheet.cells(RowNum, 4).NumberFormat = "@"
ExcelSheet.cells(RowNum, 4).Value = oBlokjeReference.Handle
ExcelSheet.cells(RowNum, 5).Value = oBlokjeReference.Layer
ExcelSheet.cells(RowNum, 6).Value = ThisDrawing.GetVariable("dwgprefix")
ExcelSheet.cells(RowNum, 7).Value = ThisDrawing.GetVariable("dwgname")
Array1 = oBlokjeReference.GetAttributes
For Count = LBound(Array1) To UBound(Array1)
nKol1 = WelkeKolomMod(Trim(Array1(Count).TagString), ExcelSheet, UBound(EersteRij) + 1)
ExcelSheet.cells(RowNum, nKol1).NumberFormat = "@"
ExcelSheet.cells(RowNum, nKol1).Value = Trim(Array1(Count).TextString)
Next Count
RowNum = RowNum + 1
End If
Next oBlokje
Set Excel = Nothing
Set ExcelSheet = Nothing
End Sub
对不起，里面有荷兰语.：-）
页:
[1]