[VBA] Utwórz i odczytaj XDATA

[pop3k]

Witam, poczytałem troszkę na forum o XDATA, lecz nie znalazłem do końca odpowiedzi.

Chciałbym użyć XDATA w mojej aplikacji. Tak jak ktoś kiedyś napisał przy tworzeniu pojedynczego, prostego pręta - chciałbym przechować informację poza długością i średnicą (co można uzyskać po samej geometrii) - np. klasę stali, ciężar, cenę takiego pręta.

Pytanie jak mogę zainfekować moją kreskę, zespół kresek informacją XDATA?

No i w jaki sposób tę informację odzyskać w kolejnej aplikacji?

[kruszynski]

Przykład zapisu i odczytu XDaty może być taki:

Public Sub ZapisXDaty()
    Dim linia As ZcadEntity
    
    Dim XType(0 To 9) As Integer
    Dim XData(0 To 9) As Variant
    Dim reals3(0 To 2) As Double
    Dim worldPos(0 To 2) As Double
    
    XType(0) = 1001: XData(0) = "TestowaAplikacja"
    XType(1) = 1000: XData(1) = "przykładowy tekst"
    XType(2) = 1003: XData(2) = "0"
    XType(3) = 1040: XData(3) = 1.23479137438413E+40
    XType(4) = 1041: XData(4) = 1237324938
    XType(5) = 1070: XData(5) = 32767
    XType(6) = 1071: XData(6) = 32767
    XType(7) = 1042: XData(7) = 10
    
    reals3(0) = -100.23: reals3(1) = 100.23: reals3(2) = -20
    XType(8) = 1010: XData(8) = reals3

    worldPos(0) = 200.23: worldPos(1) = 200.23: worldPos(2) = -10
    XType(9) = 1011: XData(9) = worldPos
    
    Set linia = Sel("Wybierz element")
    linia.SetXData XType, XData


End Sub

Public Sub OdczytXDaty()
    
    Dim selected As ZcadEntity
    
    Dim xdataOut As Variant
    Dim xtypeOut As Variant
    
    Set selected = Sel("Wybierz element")
    
    selected.GetXData "", xtypeOut, xdataOut
    For Each v In xdataOut
        If VarType(v) >= 8192 Then
            ThisDrawing.Utility.Prompt v(0)
            ThisDrawing.Utility.Prompt v(1)
            ThisDrawing.Utility.Prompt v(2)
        Else
            ThisDrawing.Utility.Prompt v
        End If
    Next
    
End Sub

Public Function Sel(ByVal txt As String) As Object

    Dim obj As ZcadEntity
    Dim px As Variant
    On Error Resume Next
        ThisDrawing.Utility.GetEntity obj, px, txt
    On Error GoTo 0
    Set Sel = obj

End Function