XData

[Anonymous]

Hi

See the photo in the attach file
what I need is
how I can assign selected item as Xdata for any opject user will draw after click the xdata CommandButton
the normal draw way using the autocad command


thanks

[Anonymous]

Any Help please ???

[Anonymous]

I try Objectadded event to add xdata but it gave me error "Object open for read"

[arcticad]

This should help you out dealing with XData

{code}

'Purpose
'Erases extended entity data, xdata, attached to an object. If an
'application name is not specified, then all xdata is erased.

'Arguments
'An AcadObject and optionally a registered application name.

'Example
'Call ClearXData(myAcadObject, "ACADX")

'Notes
'ClearXData() will not erase xdata saved by AutoCAD.

Sub SetXdata()
Dim sset As AcadSelectionSet
Call SsetMake("sset")
Set sset = ThisDrawing.SelectionSets.item("sset")
sset.SelectOnScreen

Dim Color As String
Dim xdataType(0 To 1) As Integer, xdata(0 To 1) As Variant
For Each item In sset

If TypeOf item Is AcadHatch Then
xdataType(0) = 1001: xdata(0) = "My Hatch Data"
xdataType(1) = 1000: xdata(1) = item.Color
item.SetXdata xdataType, xdata
End If
Next

End Sub


Sub GetXdata()
Dim sset As AcadSelectionSet
Call SsetMake("sset")
Set sset = ThisDrawing.SelectionSets.item("sset")
sset.SelectOnScreen

Dim Color As String
Dim xdataOut As Variant
Dim xtypeOut As Variant

For Each item In sset
item.GetXdata "", xtypeOut, xdataOut
Next

End Sub


Sub StoreXdata(item As Variant, Text As String, value As Variant)
Dim xdataType(0 To 1) As Integer, xdata(0 To 1) As Variant
Exit Sub

xdataType(0) = 1001: xdata(0) = Text
xdataType(1) = 1000: xdata(1) = value
If ThisDrawing.layers(item.layer).Lock = False Then
item.SetXdata xdataType, xdata
Else
UnLockLayer item.layer
item.SetXdata xdataType, xdata
LockLayer item.layer
End If

End Sub


Function RetrieveXdata(item, Text As String) As Variant
Debug.Print
If TypeOf item Is AcadPViewport Or TypeOf item Is AcadViewport Or TypeOf item Is AcadModelSpace Or TypeOf item Is AcadPaperSpace Then Exit Function
Dim xdataOut As Variant
Dim xtypeOut As Variant
item.GetXdata "", xtypeOut, xdataOut
If isValid(xdataOut) Then
For I = LBound(xdataOut) To UBound(xdataOut)
If Not isValid(xdataOut(I)) Then
If UCase(xdataOut(I)) = UCase(Text) Then
If Not I + 1 > UBound(xdataOut) Then
RetrieveXdata = xdataOut(I + 1)
Exit For
End If
End If
End If
Next
End If

End Function


Public Sub ClearXData(obj As AcadObject, Optional RegApp As String = "")
Const regAppKey As Integer = 1001
Const acadApp As String = "ACAD"

Dim XDType As Variant
Dim XDData As Variant
Dim NewType(0) As Integer
Dim NewData(0) As Variant
Dim I As Integer

obj.GetXdata AppName:=RegApp, xdataType:=XDType, XDataValue:=XDData

If Not IsEmpty(XDType) Then
For I = LBound(XDType) To UBound(XDType)
If XDType(I) = regAppKey Then
If Not XDData(I) Like acadApp Then
NewType(0) = regAppKey
NewData(0) = XDData(I)
obj.SetXdata xdataType:=NewType, XDataValue:=NewData
End If
End If
Next I
End If

End Sub

Function inc(myArray As Variant) As Variant
Dim temparray() As Variant
If isValid(myArray) Then
ReDim Preserve myArray(UBound(myArray) + 1)
Else
ReDim myArray(0)
End If
inc = myArray
End Function

Function isValid(myArray As Variant) As Boolean
On Error GoTo theend
Dim I As Variant
For Each I In myArray
isValid = True
Exit Function
Next
theend:
isValid = False
End Function

Function LockLayer(layer)
If layer = "" Then Exit Function
ThisDrawing.layers(layer).Lock = True
End Function

Function UnLockLayer(layer)
If layer = "" Then Exit Function
ThisDrawing.layers(layer).Lock = False
End Function

Public Sub SsetMake(ssetname As String)
Dim sset As AcadSelectionSet
Dim ssetcheck As Boolean
For Each sset In ThisDrawing.SelectionSets
If sset.Name = ssetname Then
ssetcheck = True
Exit For
End If
Next
If ssetcheck Then
ThisDrawing.SelectionSets.item(ssetname).Delete
Set sset = ThisDrawing.SelectionSets.Add(ssetname)
Else
Set sset = ThisDrawing.SelectionSets.Add(ssetname)
End If
End Sub



{code}

[Anonymous]

Thanks for your reply

I have no problem in XData the problem in -- set XData for new object when create it --

the event

" AcadDocument_ObjectAdded(ByVal Object As Object) "

gave you the object after you add it but when I try to set Xdata I get error "object for read"

the Application should set xdata for objects during drawing not after finishing the draw

in other way I don't want select the object after I finish the draw to set Xdata it should be already there because I set it while I draw

I hop this clearing my point

[arcticad]

The simple answer is you can't.
The Object will be in use while the ObjectAdded event is running.
You can't fix this. You will have to side step it.
You will need to store the information of the added object. (objectID)
I normally just store it in a dictionary entry and then check if the entry exists and do the next step.

{code}
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
' if my dictionary is this value then
' Get this objectID
' and do something with it.
' Delete Dictionary
End Sub

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
' Store ObjectID in dictionary
End Sub
{code}