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