Insert Block on insertionpoints from block in selection set

[stefanveurink68AXD]

Dear everybody, 

I'm trying to write some macro now for several weeks and although I've been able to find lots of information on sites like this one, i can't get through the following problem: 

In the drawing there's several blocks, which are selected by user and then added to a selection set. 

What I want to do now is to insert a new block, which is created by the macro, on the same insertion point as all the selected blocks, next to that, i want the inserted blocks on the same layer as the selected block. 

So, I know how to insert a block on a certain point by manually tell the insertion point(0 to 2). But I can't find out how to get the insertion point from a block in the selection set, and use this insertionpoint as insertionpoint for the new block. Probably, when I know how to do one, by saying "for each x in y" i guess it will be possible for all the blocks in the selection set. 

Could someone give me some hint or link where the thing I want is described?

Thanks. 

[norman.yuan · Accepted solution]

So, you literally want to duplicate the blocks being selected, right? Assume you have already had a selectionset created by your code, then, yes, you can loop through it by "For Each...Next" to get your job done, something like (not tested, just give you an idea):

Private Sub DuplicateSelectedBlock(ss As AcadSelectionSet)

  Dim ent As AcadEntity

  Dim blk As AcadBlockRefernce

  Dim newBlk As AcadBlockReference

  Dim count As Integer

  For Each ent In ss

    '' if you are sure all selected are blocks, you may not have to do this test

    If TypeOf ent Is AcadBlockReference Then 

        Set blk = ent '' This selected block gives all information you need to insert a new one.

        '' assume all selected entities are in ModelSpace

        Set newBlk = ThisDrawing.ModelSpace.InsertBlock( _

             blk.InsertionPoint, blk.EffectiveName, blk.XScaleFactor, blk.YScaleFactor, blk.ZScaleFactor, blk.Rotattion)

        newBlk.Layer=blk.Layer

        newBlk.Update

        count = count + 1

    End If

  Next

  MsgBox "Blocks being duplicated: " & count

End Sub

[stefanveurink68AXD]

Excellent!! this works perfectly!!

This blk.insertionpoint was the missing link I was looking for.  Putting your (slighty changed) code into my macro gives the exact result I was looking for. Thank u very much!!