使用VBA插入块
我试图通过vba将一个块从“主块”图形插入到另一个图形中。这张“主块”图几乎包含了我们所有的块。我可以将dwg文件作为块插入，没有任何问题。但我不确定从何处开始，将主块图形中的特定块插入到另一个图形中。我是否使用insertblock方法？
提前谢谢。 一般方法是打开块容器文件：
Dim objContainFile作为一个DDocument
设置objContainFile=ThisDrawing。应用文件。打开（文档路径）
（或者，如果您希望在后台打开文档，请使用AxDbDocument。使用VBA项目中包含的相应ObjectDBX引用打开）
现在打开容器文件：
objContainFile。CopyObjects（对象，当前图形）
其中，对象是所需的块，当前图形是复制的块新文档。 我很抱歉，但我觉得我有点迷路了。
以下是更多信息：
希望在图形中插入块（Drawing1.dwg）
我要插入的块在以下目录中名为Block\u drawing\u civil的图形中命名为C01:C:\hfl\u civil\u blocks
所以代码应该是
Dim objContainFile as AcadDocument
Set objContainFile = AxDbDocument.Open("C:\hfl_civil_blocks\block_drawing_civil.dwg")
我该怎么办。我仍然使用insertblock方法吗？如何将块从一个图形中转移到另一个图形中？
非常感谢你的帮助。
事实上，我道歉。我在最初的帖子中略过了一两个关键步骤。下面的示例显示了如何处理列出的参数。
Option Explicit
Sub TestDwg2DwgBlkTrans() 'Change as required
Dim strPath As String
Dim strBlockName As String
Dim objBlock As AcadBlock
Dim entRef As AcadBlockReference
Dim dblPkPt() As Double
strBlockName = "C01"
strPath = "C:\hfl_civil_blocks\block_drawing_civil.dwg"
On Error Resume Next
Set objBlock = ThisDrawing.Blocks.Item(strBlockName)
On Error GoTo 0
If Not objBlock Is Nothing Then objBlock.Delete 'To reinitialize Block from container file
DbxCopyBlock strBlockName, strPath 'Copy block into ThisDrawing
dblPkPt = ThisDrawing.Utility.GetPoint(, "Pick insertion Point: ") 'Get insertion point for test insert
Set entRef = ThisDrawing.ModelSpace.InsertBlock(dblPkPt, "C01", 1#, 1#, 1#, 0#) 'Test insert
End Sub
Sub DbxCopyBlock(strBlockName As String, strPath As String)
Dim strFullDef As String
Dim objBlock As AcadBlock
Dim colBlocks As AcadBlocks
Dim objArray(0) As Object
Dim ACDbx As Object
Set ACDbx = GetAcDbxDoc()
ACDbx.Open strPath
Set colBlocks = ACDbx.Blocks
Set objBlock = colBlocks.Item(strBlockName) 'Find appropriate block in container file's Blocks Collection
Set objArray(0) = objBlock 'Create object array as required by the CopyObjects Method
ACDbx.CopyObjects objArray, ThisDrawing.Blocks 'Copy to current drawing's Blocks Collection
Set ACDbx = Nothing
End Sub
Function GetAcDbxDoc() As Object
Dim strAcadVersion As String
With ThisDrawing.Application
strAcadVersion = Mid(.Version, 1, 2)
If CInt(strAcadVersion) < 16 Then
Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument")
Else
Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument." & strAcadVersion)
End If
End With
End Function 非常感谢您的帮助。
我对联机代码有点问题
设置GetAcDbxDoc=。GetInterfaceObject（“ObjectDBX.AxDbDocument。”&斯特拉卡版本）
它告诉我“需要对象”，我认为这可能与我的引用有关，但我加载了AutoCAD/ObjectDBX common 16.0类型库。所以我不确定是否还有我需要的其他参考资料，或者这甚至不是问题所在。
再次感谢你的帮助。 有几件事：
我不使用Civil 3d，所以我没有任何直接的测试方法。
我以为2008年使用了ObjectDBX common 17.0，但我可能错了。双重检查是查询AutoCAD系统变量ACADVER。如果在命令行中键入，则整数部分将是strAcadVersion中在行中所需的数字：
Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument." & strAcadVersion)
这可能是有道理的，只是硬编码。
另一件事与objectDBX问题无关——代码行：
On Error Resume Next
Set objBlock = ThisDrawing.Blocks.Item(strBlockName)
On Error GoTo 0
If Not objBlock Is Nothing Then objBlock.Delete 'To reinitialize Block from container file
我们进行了一些初步测试，将需要重新设计日常使用的例行程序。 我现在一切都很好。非常感谢您的帮助。非常感谢。
但我还有一个与此相关的问题。
有没有办法选择要将块插入的绘图任务。我可以把它插入上次访问的文件中吗？我从access数据库发送此信息，有时我们会打开两个或多个autocad会话。如果是这种情况，那么我希望能够选择会话并将块插入到我选择或激活的特定会话中。似乎当前程序将块插入到首先打开的会话中。
谢谢
您说您是“从access数据库发送”，所以我假设您在某个时候使用了GetObject（）（这也解释了为什么第一个AutoCAD会话得到优先处理）。
如果是这样，是否可以通过从目标会话调用的AutoCAD VBA例程启动访问代码？这样你就有机会通过这张图。可以想象，应用程序是访问例程的正确实例，因此不需要GetObject。 我编写了一些代码，从AutoCAD的一个会话中打开access数据库，但它似乎并没有解决我的问题。
但我什么都没通过，我所做的只是从一个不是第一次打开的AutoCAD会话中打开db。不幸的是，当我试图将块发送回CAD时，它转到了第一个实例。
但当我打开它时，我可能能够“传递”当前图形以访问它。（如果我能想出办法的话）。我会尽量让你知道的。
页:
[1]