I have the following:
Dim sweepLayer As Layer
For Each sweepLayer In ActiveDocument.ActivePage.Layers If sweepLayer.name = "RepMap" Then changedLayer = True sweepLayer.Activate Set sr = sweepLayer.Shapes Exit For End IfNext sweepLayer
For Each shapex In sr
shapex.Duplicate
' Here is where I do not know how to move the duplicated shape into some other Layer, example
' would be Layer named "DiffLayer"
Next shapex
Many thanks to both of you respondents.
Here is what I ended up with:
Dim myLayer As Layer Set myLayer = ActivePage.ActiveLayer For Each shapex In sr Dim myShapeRange As New ShapeRange shapex.Duplicate myShapeRange.Add (shapex) myShapeRange.MoveToLayer myLayer Next shapex
Using 2018, X7 I did find that I needed to myDocument.Save every several hundred duplications, else CD2018 just crashes and exits, no warning. Apparently the Object Manager just gets overwhelmed.
try this:
' here code where you found sweepLayer
Dim srCopy As New ShapeRange set srCopy = sr.Duplicate srCopy.MoveToLayer myLayer