Copy objects or Copy Selection Set - VBA.. 1

[basepointdesignz]

Hi,

I'm trying to write a small module in VBA that will create a selection set from a small section of a drawing and then copy the entities to a new location and then rescale them all to 0.4..

I've already coded the program to get the s.set but I can't seem to copy them. The help files say that you can't use the Copy method while iterating through a collection (the entities in the s.set). So how, do I do it?

Do I ReDim an array variable depending on the count of the s.set and then use a loop to send each entity to the array? If so, which loop would get the best results. I've tried all sorts but can't get the entities to copy.

Any suggestions?

Cheers,

Renegade..

 

[borgunit]

This is pretty much from the ACADX site. You will need to move or rescale after the copies are made...

Sub CopyUs()
Dim ss As AcadSelectionSet
'dim doc As AcadDocument

'Set doc = ThisDrawing.Application.Documents("Drawing1.dwg&quot
Set ss = CreateSelectionSet
ss.SelectOnScreen
ThisDrawing.CopyObjects ssArray(ss), ThisDrawing.ModelSpace
ThisDrawing.Regen acAllViewports
End Sub

Public Function CreateSelectionSet(Optional ssName As String = "ss&quot 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

 

[basepointdesignz]

Thanks Borgunit,

I'll read it through and adjust as applicable..

Much appreciated,

Renegade..