Move oBject by a selection set

[grobnik]

Please some body could help me ??
The scope is search a specific polyline, get own coordinates and move all object included polilyne to 0,0,0 coordinates.
I'm able to find polyline, I'm able to find all objects but I'm not able to move objects.
If I try to use move command I got an error, for example oSset.Move Coords, CorrdsNew '(0,0,0 Dwg Origin)
(of course due to PolyLine coordinates [CLOSED POLYLINE] is an array of 7 items I'll use only the first 3).

I need a procedure with-out selecting object(s) on screen are more 100 DWG set.

Thank you

Sub prova()
setName = "MySEL"
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
    ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i


ThisDrawing.Application.ZoomExtents
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.Select acSelectionSetAll


For Each Item In oSset
    If TypeOf Item Is AcadLWPolyline Then
        If Item.Layer = "0" Then
            If Item.color = acWhite Then
                If Item.Closed = True Then
                    Coords = Item.Coordinates
                    Exit for


                End If
            End If
        End If
    End If
Next
        
'HERE I WOULD LIKE TO MOVE ALL SELECTED OBJECT TO A NEW SET OF COORDINATES STARTING FROM THOSE GET FROM COORDS VARIABLE.
 End Sub

[RICVBA]

once you have all objects to move, you must move each one by itself using the "Move" method (that applies to all drawing objects)
here's the AutoCAD ActiveX and VBA Reference example

Sub Example_Move()
    ' This example creates a circle and then performs
    ' a move on that circle.
    
    ' Create the circle
    Dim circleObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 2#: center(1) = 2#: center(2) = 0#
    radius = 0.5
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
    ZoomAll
    
    ' Define the points that make up the move vector
    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    point1(0) = 0: point1(1) = 0: point1(2) = 0
    point2(0) = 2: point2(1) = 0: point2(2) = 0
        
    MsgBox "Move the circle 2 units in the X direction.", , "Move Example"
    
    ' Move the circle
    circleObj.Move point1, point2
    
    ZoomAll
    MsgBox "Move completed.", , "Move Example"
    
End Sub

of course, you don't need all that circle/center/raidus stuff, but only points1 and point2 settings and then using a statament like

myObject.Move point1, point2

inside your iterating-through-your-objects loop
I'd also suggest you the following:

1) use selectionset to find your LightWeightPoly, instead of iterating through all your drawing objects
this will improve the overall performance of your routine
as an example you could use a function like the following

Sub SelectLWPolys(sset As AcadSelectionSet, myLayer As String, closed As Integer)

    Dim gpCode(2) As Integer
    Dim dataValue(2) As Variant
    
    gpCode(0) = 0:     dataValue(0) = "LWPOLYLINE"
    gpCode(1) = 8:     dataValue(1) = myLayer 
    gpCode(2) = 70:    dataValue(2) = closed
    ZoomExtents
    sset.Select acSelectionSetAll, , , gpCode, dataValue

End Sub

to call in your main routine (passing 'oSSet', '0' and '1' as parameters) and have your selectionset filled with all LWPolys that match the criteria and then loop through them to get the one with colour = acWhite (hope there you'll find only one of them!)

2) you could use the technique of setting a selectionset I showed you in the previous post (http://forums.augi.com/showthread.ph...41#post1287341
i.e. use a statement like

Set oSSet = CreateSelectionSet("MySEL", ThisDrawing)

to get advantage of "CreateSelectionSet(SSset As String, Optional myDoc As Variant)" function to obtain a valid and empty brand new selection set