社区 › VB › Excel和AutoCad之间的双向链接

Matt__W 发表于 2012-1-24 06:07:50

Excel和AutoCad之间的双向链接

大家好
我是这里的新成员，我一直在努力寻找问题的答案。我是一名学生，现在正在写论文。我这里有个问题。如何在Excel和AutoCad之间建立双向链接。我的意思是，如果我在AutoCad绘图中移动一个块，如果Excel可以将新坐标更新到Excel工作表中，那就太好了。反过来说，如果我在Excel中更改块坐标，它会移动AutoCad绘图中的块。我知道这可以由VBA完成，但我不#039；我不知道怎么做&nbsp；你能帮我做这个吗？已经谢谢你了。（我对可能出现的拼写错误表示歉意）致以最诚挚的问候

Matt__W 发表于 2012-1-24 13:20:05

您需要2个VBA应用程序：1.从AutoCAD打开并更新Excel或直接更新csv文件。2.从Excel打开并更新AutoCAD或使用开放式设计软件
如果只是块引用，如果块名称是唯一的，或者将对象句柄保存在excel中，那么这应该相当容易。警告：如果必须恢复图形，则句柄可能会更改或块名称可能会更改
这就是为什么我的块有一个记录编号属性，该属性对于每个块插入都是唯一的
希望这能帮助你开始。

Matt__W 发表于 2012-1-25 07:20:11

您好，Chuck，因此在属性数据中为每个块指定不同的数字。你用这个数字来识别每个区块。正当使用两个不同的VBA应用程序是什么意思？

Matt__W 发表于 2012-1-25 09:40:32

AutoCAD中的每个对象都有一个唯一的ID号-a“；处理&nbsp；您可以使用它来更新电子表格
你不&#039；不需要两个应用程序&nbsp；我想他是在指出，可以从AutoCAD到Excel，或者从Excel到AutoCAD&nbsp；从Excel到AutoCAD的代码可能要长一点，但不会太长
我可能在某个地方有一个旧的示例应用程序&nbsp；如果我找到它，我&#039；我会贴出来的。

Matt__W 发表于 2012-1-25 10:00:05

好的，谢谢你的信息，但不是&#039；t the“；“处理”；仅当您将阻止信息导出到某个位置时才变大？如果再次发送该信息，即使是同一块，AutoCad也会将新句柄变大？一个示例应用程序将是非常好的谢谢你。

Matt__W 发表于 2012-1-25 17:01:06

如果恢复dwg，我注意到有时它会重新创建块引用，并给它一个与我第一篇文章不同的句柄
至于两个VBA应用程序：
假设我在不打开AutoCAD的情况下打开excel电子表格，对插入点进行更改保存并关闭，然后我将dwg作为附件发送给其他人
如果VBA应用程序仅在dwg中，是否在excel中进行了更改？是否在dwg内进行了更改
如果我打开dwg，请使用移动命令或抓取夹点并移动块保存并关闭
如果我在excel中只有一个VBA应用程序，并且我通过电子邮件发送excel文件而不打开它，那么它不会#039；它没有变化

Matt__W 发表于 2012-1-25 17:08:15

关于处理的更多信息：我有一个用AutoCAD 2004编写的自定义GIS系统（不是地图）
我使用句柄和属性来实现双向连接和冗余
在数据库中，我存储句柄和递增的long值（Rec\u Num）
然后，在恢复dwg文件后，我们可以运行数据库重新连接功能，该功能为
1。为每个对象创建一个带有Rec Num att的块选择集，搜索数据库并保存正确的句柄（如果没有&#039；t匹配
在每次恢复中，我们已经看到多达150个句柄在映射中发生变化
；

Matt__W 发表于 2012-1-25 18:30:37

以下是一些AutoCAD代码（在AutoCAD 2004中）供您入门。您需要在VBA项目中添加对Microsoft Excel的引用。所有代码都在ThisDrawing模块中Option Explicit
Private ExcelApp As Excel.Application
Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
Dim objBlkRef As AcadBlockReference
Dim varInsPnt As Variant
Dim strHandle As String
'New Entity
'Add to Excel File
If TypeOf Object Is AcadBlockReference Then
      Set objBlkRef = Object
      varInsPnt = objBlkRef.InsertionPoint
      strHandle = objBlkRef.Handle
      If UpdateExcel(strHandle, varInsPnt, "New") = False Then
         Debug.Print "There was an Error Updating Excel"
      End If
End If
End Sub
Private Sub AcadDocument_ObjectModified(ByVal Object As Object)
Dim objBlkRef As AcadBlockReference
Dim varInsPnt As Variant
Dim strHandle As String
'Existing Entity
'Should be in Excel File
If TypeOf Object Is AcadBlockReference Then
      Set objBlkRef = Object
      varInsPnt = objBlkRef.InsertionPoint
      strHandle = objBlkRef.Handle
      If UpdateExcel(strHandle, varInsPnt, "Existing") = False Then
         Debug.Print "There was an Error Updating Excel"
      End If
End If

End Sub
Private Function UpdateExcel(sHandle As String, varpnt As Variant, sAction As String) As Boolean
Dim objWorkBook As Workbook
Dim objSheet As Worksheet
Dim objUsedRange As Range
Dim lngRows, lngRow As Long
Dim strFile As String
Dim blnFound As Boolean
Dim intcnt As Integer

On Error GoTo Err_Control
strFile = Replace(ThisDrawing.FullName, ".dwg", ".xlsx")
If ConnectToExcel = True Then
Set objWorkBook = ExcelApp.Workbooks.Open(strFile)
Set objSheet = objWorkBook.Worksheets(1)
Set objUsedRange = objSheet.UsedRange
'Get Last used row
lngRows = objUsedRange.Rows.Count + 1

Select Case sAction
      Case "New"
         'Add new blocks info
         objSheet.Cells(lngRows, 1) = sHandle
         For intcnt = LBound(varpnt) To UBound(varpnt)
               objSheet.Cells(lngRows, intcnt + 2) = varpnt(intcnt)
         Next
      Case "Existing"
         'Find Handle in Used Rows
         For lngRow = 1 To lngRows - 1
                If sHandle = objSheet.Cells(lngRow, 1) Then
                     For intcnt = LBound(varpnt) To UBound(varpnt)
                        objSheet.Cells(lngRow, intcnt + 2) = varpnt(intcnt)
                     Next
                     blnFound = True
                End If
         Next
         If blnFound = False Then 'Didn't find it add it
                objSheet.Cells(lngRows, 1) = sHandle
                For intcnt = LBound(varpnt) To UBound(varpnt)
                     objSheet.Cells(lngRows, intcnt + 2) = varpnt(intcnt)
                Next
         End If
      Case Else 'this should not happen unless you mistype the action name
End Select
objWorkBook.Save
objWorkBook.Close
Set ExcelApp = Nothing
UpdateExcel = True
End If
Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
      Case 1004 'File doesn't exist(Not sure if anything else causes this error)
         'create a new workbook and save as         
         Set objWorkBook = ExcelApp.Workbooks.Add
         objWorkBook.SaveAs strFile
         Resume
      Case Else
         Debug.Print Err.Number & ": " & Err.Description
         Resume Exit_Here
End Select
End Function
Private Function ConnectToExcel() As Boolean
On Error GoTo Err_Control
Set ExcelApp = GetObject("Excel.Application")
ConnectToExcel = True

Exit_Here:
ExcelApp.AlertBeforeOverwriting = False
Exit Function
Err_Control:
Select Case Err.Number
      Case Else
         Set ExcelApp = CreateObject("Excel.Application")
         ConnectToExcel = True
         Resume Exit_Here
End Select
End Function

Matt__W 发表于 2012-1-26 01:42:50

好的。我得仔细看看你写的东西。我自己并不熟悉VBA，但我可以在这方面得到帮助。非常感谢你的帮助。

Matt__W 发表于 2012-1-26 01:51:30

我们可以在这里帮助你，但我们需要更多信息
也就是说，你对编码了解多少，AutoCAD和Excel的版本是什么，这个项目的全部内容是什么，你的电脑上有这两个版本的运行副本吗？还有，这个项目是做什么的，你要交什么
我不想只给你代码让你打分。我想帮助你理解代码以及如何思考。我不知道其他人对此有何感受，这只是我的感受。帮助别人获得代码来完成他们的工作是一回事，但给别人一个等级的代码是完全不同的IMHO。这就是说，坚持住，我们可以散列代码，直到你理解它，可以写你需要的，只要一点帮助这里和F1键。

查看完整版本: Excel和AutoCad之间的双向链接