[VBA] Utwórz i odczytaj XDATA


Rekomendowane odpowiedzi

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?

Odnośnik do komentarza
Udostępnij na innych stronach

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

 

Odnośnik do komentarza
Udostępnij na innych stronach

Dołącz do dyskusji

Możesz dodać zawartość już teraz a zarejestrować się później. Jeśli posiadasz już konto, zaloguj się aby dodać zawartość za jego pomocą.

Gość
Dodaj odpowiedź do tematu...

×   Wklejono zawartość z formatowaniem.   Usuń formatowanie

  Dozwolonych jest tylko 75 emoji.

×   Odnośnik został automatycznie osadzony.   Przywróć wyświetlanie jako odnośnik

×   Przywrócono poprzednią zawartość.   Wyczyść edytor

×   Nie możesz bezpośrednio wkleić grafiki. Dodaj lub załącz grafiki z adresu URL.

Ładowanie