How do I Copy a hatch into a new block

Look up the following functions at http://www.acadx.com:

How Do I....? --> VB --> Use existing objects to create a block definition?

The functions CreateSelectionSet and ssArray that the answer uses are in the
"Visual Basic" section of the website

James

 

I have a selection set containing any kind of entity. I need to make the
selection into a block that I will insert. The only way I've found is to
recreate each object in the block. However, I don't know how to do this
with a hatch. Is there a better way to copy all items from a selection set
into a block?

here is what I have so far.

Private Sub cmdGo_Click()
Dim acdBlock As AcadBlock
Dim ss As AcadSelectionSet
...
Set ss = CreateSelectionSet("ssDetailMagnify")
ss.SelectByPolygon acSelectionSetCrossingPolygon, pts
Set acdBlock = ThisDrawing.Blocks.Add(pt, txtName.Text)
For i = 0 To ss.Count - 1 Step 1
CopyEntityToBlock acdBlock, ss.Item(i)
Next
...
End sub

Public Sub CopyEntityToBlock(blk As AcadBlock, ent As AcadEntity)
Dim newEnt As AcadEntity
Select Case UCase(ent.ObjectName)
Case "ACDBLINE":
Dim lne As AcadLine
Set lne = ent
Set newEnt = blk.AddLine(lne.StartPoint, lne.EndPoint)
' ...Other cases for other entity types...
Case "ACDBHATCH":
' Dim ht As AcadHatch, ht2 As AcadHatch
' Set ht = ent
' Set ht2 = blk.AddHatch(ht.PatternType, ht.PatternName,
ht.AssociativeHatch)
' ht2.PatternAngle = ht.PatternAngle
' ht2.PatternDouble = ht.PatternDouble
' ht2.PatternSpace = ht.PatternSpace
' ... How do I set the inner and outer loops?
' Set newEnt = ht2
Case Else
'TODO: other entity types
Exit Sub
End Select
On Error Resume Next
newEnt.Color = ent.Color
newEnt.Layer = ent.Layer
newEnt.Linetype = ent.Linetype
newEnt.Lineweight = ent.Lineweight
newEnt.LinetypeScale = ent.LinetypeScale
newEnt.PlotStyleName = ent.PlotStyleName 'error if in color dependant
plot mode
Err.Clear
End Sub