Object open for read!

I hate drawings that were not organized on layers.
and so i wish to write a program to monitor newly added objects.

i thought it would be as simple as this;

Code:

---

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
      If TypeName(Object) = "IAcadDimRotated" Then Object.Layer = "Dim"   
End Sub

---

This is supposed to be monitoring Rotated Dimension Objects and put them in the "Dim" layer, but it has this error when a rotated dimension is added.

Run-time error '-2145386418 (80200004e)';
Object was open for read.

Does anybody know how to fix this?

This is the problem with the ObjectAdded event that you cannot modify the returned object. Rediculous but true.

I have a similar situation where I want to remove specific XData from copied objects. I use a collection with the help of the BeginCommand & EndCommand events to collect and modify the objects. One thing that complicates the issue is no CommandCancelled event as the copy command can be cancelled with objects still being created. Below is my code. Note that it also has to check commands that have a copy option within them.

Regards - Nathan

Code:

---

Option Explicit
Private objCollection As Collection

Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
Dim Object As Object
Dim intXdatatype(0) As Integer
Dim varXdata(0) As Variant
If Not objCollection Is Nothing Then
        For Each Object In objCollection
                'Start remove XData
                On Error Resume Next
                intXdatatype(0) = 1001
                varXdata(0) = "E3-DEFINING-POINT"
                Object.SetXData intXdatatype, varXdata
                varXdata(0) = "TEXT_HEADER"
                Object.SetXData intXdatatype, varXdata
                varXdata(0) = "TEXT_FRAGMENT"
                Object.SetXData intXdatatype, varXdata
                On Error GoTo 0
                'End remove XData
        Next Object
        Set objCollection = Nothing
End If
Select Case CommandName
        Case "COPY", "PASTECLIP", "SCALE", "ROTATE"
                Set objCollection = New Collection
End Select
End Sub

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
Dim Object As Object
Dim intXdatatype(0) As Integer
Dim varXdata(0) As Variant
If Not objCollection Is Nothing Then
        For Each Object In objCollection
                'Start remove XData
                On Error Resume Next
                intXdatatype(0) = 1001
                varXdata(0) = "E3-DEFINING-POINT"
                Object.SetXData intXdatatype, varXdata
                varXdata(0) = "TEXT_HEADER"
                Object.SetXData intXdatatype, varXdata
                varXdata(0) = "TEXT_FRAGMENT"
                Object.SetXData intXdatatype, varXdata
                On Error GoTo 0
                'End remove XData
        Next Object
        Set objCollection = Nothing
End If
End Sub

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
Select Case ThisDrawing.GetVariable("CMDNAMES")
        Case "COPY", "PASTECLIP", "SCALE", "ROTATE"
                If TypeOf Object Is AcadText Or TypeOf Object Is AcadBlockReference Then objCollection.Add Object
End Select
End Sub

---

As the error suggests, the object is still being used by the creation code and cannot be edited while another operation has it open. One way to work around this is to have a Global Array or Collection that you can place the ObjectId into, then check if that Global object has anything in it in the EndCommand event and modify it there.

thanks Miff for the idea. heres what i did.

I defined a global variable that stores the ObjectID of a newly created object, and modify its properties in the EndCommand Event via ObjectToObjectID statement.

heres the code:

Code:

---

Dim ObjID As Long

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
  If TypeName(Object) = "IAcadDimRotated" Then
      ObjID = Object.ObjectID
  End If
End Sub

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
Dim Obj As AcadObject
On Error Resume Next
Set Obj = ThisDrawing.ObjectIdToObject(ObjID)

Obj.Layer = "Dimensions" 'assuming you already had this layer
ObjID = 0 'clears the variable
End Sub

---

Viola!! a real-time Object's Layer Checker.
Maybe I will complete this project by adding settings on which layer a certain object will go to. Thanks!

The code I previously posted monitors only for a single object at each EndCommand Event. But some commands produce more objects such as dimcontinue... and much more, pasteclip. as miff's suggested, to put the ObjectID's in a global array, but I can't get it to work.

Have a look at my code for using a collection of objects.

Regards - Nathan

Here's one that I tested on DimRotated objects.....

Code:

---

Dim objID As New Collection

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
        Dim I As Integer
        Dim oEnt As AcadEntity
        Do Until objID.Count = 0
            Set oEnt = ThisDrawing.ObjectIdToObject(objID(1))
            If TypeOf oEnt Is AcadDimRotated Then
                'do whatever
                Debug.Print "Got one!"
            End If
            objID.Remove 1
        Loop

End Sub

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
  If TypeOf Object Is AcadDimRotated Then
      objID.Add Object.ObjectID
  End If
End Sub

---

It works great!! thanks to you guys.

Quote:

---

Originally Posted by miff

Here's one that I tested on DimRotated objects.....

Code:

---

Dim objID As New Collection

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
        Dim I As Integer
        Dim oEnt As AcadEntity
        Do Until objID.Count = 0
            Set oEnt = ThisDrawing.ObjectIdToObject(objID(1))
            If TypeOf oEnt Is AcadDimRotated Then
                'do whatever
                Debug.Print "Got one!"
            End If
            objID.Remove 1
        Loop

End Sub

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
  If TypeOf Object Is AcadDimRotated Then
      objID.Add Object.ObjectID
  End If
End Sub

---

---

pls could you help me with your above code retrieving the attributes of a block and modifiy them ?

thks

Quote:

---

Originally Posted by grobnik

pls could you help me with your above code retrieving the attributes of a block and modifiy them ?

thks

---

Seach this forum for "getAttributes". Also, check the tips and tricks sticky thread at the top of this forum.