BLOCK INSERT USING VBA

[smuthuc]

NOT WORKING MY VBA CODE

 

Public Sub index_test()

 

Dim strPath As String
Dim strBlockName As String
strBlockName = "INDEX"
strPath = "E:\Soft\Template\INDEX.dwg"

'On Error Resume Next
DbxCopyBlock strBlockName, strPath

strBlockName = "BSC1"
DbxCopyBlock strBlockName, strPath

Dim Pt1 As Variant

Pt1 = ThisDrawing.Utility.GetPoint(, "Pick the Index Table Corner:")

Dim BlkNme As AcadBlock
Dim BlkRef As AcadBlockReference

Set BlkRef = ThisDrawing.ModelSpace.InsertBlock(Pt1, strBlockName, 1, 1, 1, 0)

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

 

PLEASE RECTIFY ANYBODY

 

[SLW210]

Please read the code posting guidelines and use code tags for your code.