Get and Set Xdata with VBA

contact lost

hello erverybody,i'm trying to set and get xdata using the following code. i can't see whats wrong with it - but i'm not able to set or get the data - even if i set the data using the drawing-tools, i'm not able to read the data in the drawing. can anybody help?here's the code:dim datatype(0 to 1) as Integerdim data(0 to 1) as variantdim obj as intellicad.lineset obj = oicaddoc.modelspace.addline(point1, point2)datatype(0) = 1001: data(0)="testApp"datatype(1) = 1000: data(1)="test-data"obj.setxdata datatype, datadim datafound(0 to 1) as variantdim typefound(0 to 1) as variantobj.getxdata "testApp", typefound, datafoundmsgbox datafound(1) ' empty

contact lost

Found this on the web.Option ExplicitPrivate Const APP_NAME As String = "TEST_APP"Sub ReadXData() '----------------------------------------------- ' get the entity. Dim anObj As Object Dim pt As IntelliCAD.Point ActiveDocument.Utility.GetEntity anObj, pt, "Select an entity: " '----------------------------------------------- ' get its xdata. Dim xdataType As Variant Dim xdataValue As Variant Dim appName As String anObj.GetXData APP_NAME, xdataType, xdataValue '----------------------------------------------- ' iterate through the XData. Dim lbnd As Integer, ubnd As Integer Dim i As Integer If (vbEmpty <> VarType(xdataType)) Then lbnd = LBound(xdataType) ubnd = UBound(xdataType) For i = lbnd To ubnd If ( _ (1010 = xdataType(i)) _ Or _ (1011 = xdataType(i)) _ Or _ (1012 = xdataType(i)) _ Or _ (1013 = xdataType(i)) _ ) Then Dim ptX As IntelliCAD.Point Set ptX = xdataValue(i) Debug.Print "XData Type: " & xdataType(i) & " Xdata Value: " & ptX.x & "," & ptX.y & "," & ptX.z Set ptX = Nothing Else Debug.Print "XData Type: " & xdataType(i) & " Xdata Value: " & xdataValue(i) End If Next i Else Debug.Print "No XData for " & APP_NAME End If Set anObj = NothingEnd SubSub AppendXData() '----------------------------------------------- ' get the entity. Dim anObj As Object Dim pt As IntelliCAD.Point ActiveDocument.Utility.GetEntity anObj, pt, "Select an entity: " '----------------------------------------------- ' get its xdata. Dim xdataType As Variant Dim xdataValue As Variant anObj.GetXData APP_NAME, xdataType, xdataValue If (vbEmpty = VarType(xdataType)) Then Dim tmp(0 To 0) As Integer xdataType = tmp ReDim xdataValue(0 To 0) '----------------------------------------------- ' the first item in the XData should be a 1001 ' code giving the app's name. xdataType(0) = 1001 xdataValue(0) = APP_NAME End If '----------------------------------------------- ' redimension the XData arrays, preserving their ' contents. ReDim Preserve xdataType(LBound(xdataType) _ To (UBound(xdataType) + 1)) ReDim Preserve xdataValue(LBound(xdataValue) _ To (UBound(xdataValue) + 1)) '----------------------------------------------- ' stuff some new data in. xdataType(UBound(xdataType)) = 1000 xdataValue(UBound(xdataValue)) = "Hi, I was added!" '----------------------------------------------- ' store the data. anObj.SetXData xdataType, xdataValue Set anObj = NothingEnd Sub

contact lost

thank you for your prompt reply.i got a bit further now. i'm able to read data, which i have inserted in the drawing - but i still cannot write data. i tried to change xdataType to an integer array aswell - with no success.thanks againhelmut