Microstation VBA DataBlock örneği

Private Const parselMulkiyetId As Long = 1453
Private Type DBParsel
       id As Long
       Mah As String
       Ada As Long
       parsel As Long
       Yuzolcumu As Double
       Sahibi As String
       Aciklama As String
 End Type

'  AddLinkage and GetLinkage both transfer the data using TransferBlock.
'  That way, it is easy to be certain that the transfer always occur in the
'  same order.
Private Sub ParselBilgi(dblk As DataBlock, parsel As DBParsel, copyToDataBlock As Boolean)
    dblk.CopyLong parsel.id, copyToDataBlock
    dblk.CopyString parsel.Mah, copyToDataBlock
    dblk.CopyLong parsel.Ada, copyToDataBlock
    dblk.CopyLong parsel.parsel, copyToDataBlock
    dblk.CopyDouble parsel.Yuzolcumu, copyToDataBlock
    dblk.CopyString parsel.Sahibi, copyToDataBlock
    dblk.CopyString parsel.Aciklama, copyToDataBlock
End Sub

Sub BilgiEkle()
    Dim ele As element
    Dim dblk As New DataBlock
    Dim parsel As DBParsel

    If seciliElement(ele) Then
       parsel.id = 1
       parsel.Mah = "Balmumcu"
       parsel.Ada = 2500
       parsel.parsel = 1
       parsel.Yuzolcumu = 1000.58
       parsel.Sahibi = "Yıldız"
       parsel.Aciklama = "Parsel Açıklaması"
       Call ParselBilgi(dblk, parsel, True)
       ele.AddUserAttributeData parselMulkiyetId, dblk
       ele.Rewrite
    End If
End Sub

Sub BilgiOku()
    Dim ele As element
    Dim dblk() As DataBlock
    Dim parsel As DBParsel
    Dim value As Long, name As String
    If seciliElement(ele) Then
       dblk = ele.GetUserAttributeData(parselMulkiyetId)
       ParselBilgi dblk(0), parsel, False
       MsgBox "parsel bilgi" & Chr(10) _
            & "ID=" & parsel.id & Chr(10) _
            & "Mahalle=" & parsel.Mah & Chr(10) _
            & "Ada=" & parsel.Ada & Chr(10) _
            & "Parsel=" & parsel.parsel & Chr(10) _
            & "Sahibi=" & parsel.Sahibi & Chr(10) _
            & "Yüzölçümü=" & parsel.Yuzolcumu & Chr(10) _
            & "Açıklama=" & parsel.Aciklama & Chr(10)
    End If
End Sub

Function seciliElement(ByRef sElement As element) As Boolean
    Dim oScanEnumerator As ElementEnumerator
 
    If ActiveModelReference.AnyElementsSelected Then
        Set oScanEnumerator = ActiveModelReference.GetSelectedElements
        oScanEnumerator.MoveNext
        Set sElement = oScanEnumerator.Current
        seciliElement = True
    Else
        seciliElement = False
        MsgBox ("Secili Element yok")
    End If
End Function