Problems with attaching Xdata to a Layer and then retrieving the xdata

[Anonymous]

Hi everyone,

I am working on a program that will iterate through a drawings layers and convert the colours of each layer from our company standard to a client standard. I can do all this without any problems but I want to make sure that if the extar layers are added to the drawing, the program will ignore any layers that had been previously converted.

I thought that xdata would be the most appropiate way to do this. Below are the steps I want the program to do:-

1. Cycle through each layer. If xdata exists with string "converted_previously" goto next layer, Else go to step 2

2. Convert layer colours to client standard. Attach xdata to layer to ensure it does not get converted twice

I think that the xdata is being attached to the layer but I cannot appear to retrieve the xdata and place it in a variable. Below is the code I'm trying to use in relation to the xdata:-

Public Sub LAYER_COLOUR_CHECK()

Dim LAYER As AcadLayer
Dim LAYER_COLLECTION As AcadLayers

Dim LAYER_XDATA_TYPE(0 To 1) As Integer
Dim LAYER_XDATA(0 To 1) As Variant

Dim LAYER_XDATA_TYPE_RETRIEVED As Integer
Dim LAYER_XDATA_RETRIEVED As String

' Assign Values to variables for xdata

LAYER_XDATA_TYPE(0) = 1001: LAYER_XDATA(0) = "LAYER_CHECK_APP"
LAYER_XDATA_TYPE(1) = 1000: LAYER_XDATA(1) = "LAYER_CONVERSION_DONE"

Set LAYER_COLLECTION = ThisDrawing.Layers

For Each LAYER In LAYER_COLLECTION

' Attach xdata to LAYER

LAYER.SetXData LAYER_XDATA_TYPE, LAYER_XDATA

' Retrieve Xdata from LAYER

LAYER.GetXData "LAYER_CHECK_APP", LAYER_XDATA_TYPE_RETRIEVED, LAYER_XDATA_RETRIEVED

ThisDrawing.Utility.Prompt ("XDATA TYPE = " & LAYER_XDATA_TYPE_RETRIEVED) & vbCrLf

ThisDrawing.Utility.Prompt ("XDATA = " & LAYER_XDATA_RETRIEVED) & vbCrLf

If LAYER_XDATA_RETRIEVED = "LAYER_CONVERSION_DONE" Then

ThisDrawing.Utility.Prompt (LAYER.Name & " has been converted previously")
GoTo NEXT_LAYER

Else

ThisDrawing.Utility.Prompt (LAYER.Name & " has not been converted") & vbCrLf

End If

NEXT_LAYER:
Next LAYER

End Sub

Below is what is shown on the command line when I run the program

XDATA TYPE = 0
XDATA =
test layer 2 has not been converted
XDATA TYPE = 0
XDATA =
test layer 8 has not been converted

I cannot work out why I can't retrive the values for the xdata. Any help would be greatly appreciated.

Cheers,
Ian

[Anonymous]

Hi everyone I managed to get this to work.
The problem was that the program would fall over when I would call up an empty variable where the xdata was meant to be stored. What I have done is put an On Error Goto Statement which appears to have solved the problem. It's probably not the most elegant way of doing it but it worked. Here's the code below that appears to work if anyone else has a similar problem.

Public Sub XDATA_TEST()

Dim LAYER_COLLECTION As AcadLayers
Dim LAYER As AcadLayer

Set LAYER_COLLECTION = ThisDrawing.Layers

' Create a layer

'Dim NEW_LAYER As AcadLayer
'Set NEW_LAYER = ThisDrawing.Layers.Add("XDATA_TEST")


Dim DataType(0 To 1) As Integer
Dim Data(0 To 1) As Variant

DataType(0) = 1001: Data(0) = "LAYER_CHECK_APP"
DataType(1) = 1000: Data(1) = "CONVERTED_PREVIOUSLY"

For Each LAYER In LAYER_COLLECTION

' Attach the xdata to the layer
'LAYER.SetXData DataType, Data

' Return the xdata for the layer
Dim xdataOut As Variant
Dim xtypeOut As Variant
LAYER.GetXData "LAYER_CHECK_APP", xtypeOut, xdataOut

On Error GoTo NO_XDATA
'MsgBox "For Layer " & LAYER.Name & ": Xdata Type = " & xtypeOut(1) & "; xdata string = " & xdataOut(1), vbInformation, "xdata test"

If xdataOut(1) = "CONVERTED_PREVIOUSLY" Then
ThisDrawing.Utility.Prompt ("Layer " & LAYER.Name & " has been converted previously") & vbCrLf
GoTo NEXT_LAYER

Else

ThisDrawing.Utility.Prompt ("Layer " & LAYER.Name & " needs to be converted to RTA format") & vbCrLf

End If

NO_XDATA:
MsgBox "No xdata attached to layer " & LAYER.Name, vbInformation, "no xdata attached to layer"
Resume NEXT_LAYER

NEXT_LAYER:
Next LAYER

End Sub

Cheers,
Ian