[VBA] Utwórz i odczytaj XDATA


Recommended Posts

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?

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...