Change object-propertie by OD of object gives error

[Anonymous]

This is a repost, now used the Rich Text, so it should be readable.



I want to change the layer of an object by looking in the ObjectData.
With this code I see the ObjectData, put the string in a variable,
close something (the debugger gives me back the object properties), but
the layer cannot be set (see last line) because: "Object was open for
read". Thats true, but changing the flag should do the trick I thought.
Can someone tell me whats wrong?



Peter



'******************************************************************



Dim sset As Object

Dim laag As String

Dim acadobj As Object

Dim oproj As Object

Dim odatatable As Variant

Dim orecords As Variant

Dim flag As Variant

Dim rec As Variant



Set oAcadApp = ThisDrawing.Application

Set oAcadMap = oAcadApp.GetInterfaceObject("AutocadMap.Application")

Set AcadDoc = oAcadApp.ActiveDocument



Set oproj = oAcadMap.Projects(ThisDrawing)

Set odatatable = oproj.ODTables.Item("default_top10_vlak") 'created table inside drawing

Set orecords = odatatable.GetODRecords



'Give selection.

Set sset = AcadDoc.ActiveSelectionSet

sset.Clear

sset.SelectOnScreen





'Loop Through Entities

For Each acadobj In sset

flag = orecords.init(acadobj, True, False)

If flag = True Then

If orecords.isdone = False Then

Set rec = orecords.Record

laag = rec.Item(1).Value

'If InStr(1, laag, "/") Then Mid(laag, InStr(1, laag, "/"), 1) = "_"

'If InStr(1, laag, "\") Then Mid(laag, InStr(1, laag, "\"), 1) = "_"

End If 'IsDone=FALSE

End If 'flag=TRUE

'check_laag (laag) 'checks if layer exist. If not, then create it



flag = orecords.init(acadobj, False, True) 'Give back the properties



acadobj.Layer = laag 'Why is here a run-time error (-2145386418 (8020004e)) ?



Next acadobj