Convert all Drawing Objects / Entities into a Block

[Anonymous]

I couldnt find this on the internet so i figured to write it and post it here:

Private Sub BlockAll()
'define variables
    Dim objSS As AcadSelectionSet
    Dim objBlock As AcadBlock
    Dim objBRef As AcadBlockReference
    Dim strName As String
    Dim objSourceEnts() As Object
    Dim varDestEnts As Variant
    Dim intI As Integer
    Dim dblOrigin(2) As Double

'make selection set include all objects / entities
    On Error Resume Next
        ThisDrawing.SelectionSets.Item("TempSSet").Delete
        Set objSS = ThisDrawing.SelectionSets.Add("TempSSet")
        objSS.Select acSelectionSetAll

'set the user input variable and origin
    strName = "Block1" 'you can use .getstring to ask user
    dblOrigin(0) = 0: dblOrigin(1) = 0: dblOrigin(2) = 0

'create the 'empty' block using the given block name
    Set objBlock = ThisDrawing.Blocks.Add(dblOrigin, strName)

'put selected entities into an array for CopyObjects
    ReDim objSourceEnts(objSS.Count - 1)
    For intI = 0 To objSS.Count - 1
        Set objSourceEnts(intI) = objSS(intI)
    Next
    
'copy selected entities into the block
    varDestEnts = ThisDrawing.CopyObjects(objSourceEnts, objBlock)

'erase original entities, insert block, and delete array selection set
    objSS.Erase
    Set objBRef = ThisDrawing.ModelSpace.InsertBlock(dblOrigin, strName, 1, 1, 1, 0, True)
    objSS.Delete

'completion message
    MsgBox "Done."
    
End Sub

Hope this helps, If you have any suggestions to inprove this code please post below...

Thanks

[Anonymous]

Hello Noel

thanks for the Idea i want to request u that can u modify or write a new program according to my requirement

that i need a USERFORM in VBA to get points Coordinates and Make the intersection As Block in autocad

Thanks in Advance