Can I create a block from a selection set?

Hello Everyone,

I would like to create a block from a selection set. I've seen examples of
how to use the AcadBlock.Add[this or that] but I want to add things to the
block that I already have drawn.

Thanks in advance,

Patrick

 

Adding a single known object to an existing block is easy enough.

To use an unknown group of objects in a selection set would require you to
check for every different type of entity.
One possible way would be to use "Select Case" as shown at the
(non-functional) end of the demo below.

Gary

Sub AddToBlock()

'Add 2.0 dia circle centered at the origin of an existing block name
"TestBlock"
Dim oCircle As AcadCircle
Dim dCircCen(0 To 2) As Double
Dim dRadius As Double
Dim oMyBlock As AcadBlock
Dim oActiveSet As AcadSelectionSet
Dim oEntity As AcadEntity

Set oActiveSet = ThisDrawing.ActiveSelectionSet

dRadius = 1#

Set oMyBlock = ThisDrawing.Blocks("TestBlock")

dCircCen(0) = oMyBlock.Origin(0)
dCircCen(1) = oMyBlock.Origin(1)
dCircCen(2) = oMyBlock.Origin(2)

Set oCircle = oMyBlock.AddCircle(dCircCen, dRadius)

On Error Resume Next
ThisDrawing.Regen acAllViewports

For Each oEntity In oActiveSet
'Select Case oEntity.ObjectName
MsgBox oEntity.ObjectName
'Case "AcDbLine"
'Code for line
'Case "AcDbCircle"
'Set oCircle = oMyBlock.AddCircle(dCircCen, dRadius)
'Case "AcDbArc"
'Code for arc
'End Select
Next

End Sub

 

Here are some directions on our site to do this

http://code.acadx.com/howto/vb/copyobjectstoblock.htm

 

From www.acadx.com
---> How Do I?
---> Visual Basic
---> Use existing objects to create a block definition?

-----------------------------
With the myriad ways to add geometry to a block definition, there seems to
be no method for using existing geometry. In fact, there is. The CopyObjects
method allows us to do just that. Here is how:
Dim blkDef As AcadBlock, ss As AcadSelectionSet, pt
pt = ThisDrawing.Utility.GetPoint(, "Select insertion point: ")
Set blkDef = ThisDrawing.Blocks.Add(pt, "Test")
Set ss = CreateSelectionSet
ss.SelectOnScreen
ThisDrawing.CopyObjects ssArray(ss), blkDef
ss.Erase

' and the utility functions it calls... also from acadx.com
Public Function CreateSelectionSet(Optional ssName As String = "ss") As
AcadSelectionSet
Dim ss As AcadSelectionSet

On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function
Public Function ssArray(ss As AcadSelectionSet)
Dim retVal() As AcadEntity, i As Long
ReDim retVal(0 To ss.Count - 1)
For i = 0 To ss.Count - 1
Set retVal(i) = ss.Item(i)
Next
ssArray = retVal
End Function