[编程交流] 使用VBA插入块

 
Dim objContainFile as AcadDocument
Set objContainFile = AxDbDocument.Open("C:\hfl_civil_blocks\block_drawing_civil.dwg")

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

Set GetAcDbxDoc = .GetInterfaceObject("ObjectDBX.AxDbDocument." & strAcadVersion)

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