Jump to content
smuthuc

BLOCK INSERT USING VBA

Recommended Posts

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

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×