Microstation, VBA и TerraScan. Хитрый CONNECT

Не так давно я показывал небольшие наработки, которые позволяют без особых хлопот наладить взаимодействие с лазерными данными, загруженными в TerraScan, с использованием VBA. И там же я обещал продемонстрировать каким образом те самые наработки можно привести в такой вид, в котором они смогут работать в разных версиях Microstation.

Итак, сегодня я приведу небольшой пример, который данные возможности продемонстрирует, а дальше каждый заинтересованный сможет развить их для себя по аналогии. Показывать я буду в среде Microstation CONNECT версии 10.03.00.30. Никаких невероятных наворотов кода и тому подобной магии здесь нет — весь фокус заключается лишь в том, чтобы разделить макрос как бы на две части: первая будет работать в старых версиях Microstation (а именно там, где присутствует VBA 6), а вот вторая часть будет работать в новой версии, которая снабжена VBA 7-ой версии. Без сомнения, подобный огород можно не городить и держать две версии макросов — одну для той же v8, а другую для CONNECT, однако такой подход не всегда применим, хотя в определенной мере он является наиболее грамотным.

Дай нам коду!

Код очень прост и если вы видели предыдущий пост, то сразу заметите разницу:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemoryToVBA Lib "kernel32" Alias "RtlMoveMemory" (ByRef VBALocation As Any, ByVal SourceLoc As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Sub CopyMemoryFromVBA Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByRef VBALocation As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal strDest As Any, ByVal lpSource As Any, ByVal Length As LongPtr)
#Else
    Private Declare Sub CopyMemoryToVBA Lib "kernel32" Alias "RtlMoveMemory" (ByRef VBALocation As Any, ByVal SourceLoc As Long, ByVal Length As Long)
    Private Declare Sub CopyMemoryFromVBA Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByRef VBALocation As Any, ByVal Length As Long)
    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal strDest As Any, ByVal lpSource As Any, ByVal Length As Long)
#End If

#If VBA7 Then
    Declare PtrSafe Function FnScanGetPnt Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetCls Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetMrk Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetFlg Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetInt Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetLin Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetDbl Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetEch Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetAng Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetClr Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetScr Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long
    Declare PtrSafe Function FnScanGetCoordSetup Lib "tscan.dll" (ByRef Org As Point3d) As Long
#Else
    Function FnScanGetPnt(ByRef Tbl As Long) As Long
        FnScanGetPnt = GetCExpressionValue("FnScanGetPnt(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetCls(ByRef Tbl As Long) As Long
        FnScanGetCls = GetCExpressionValue("FnScanGetCls(" & VarPtr(Tbl) & ")")
    End Function

    Function FnScanGetMrk(ByRef Tbl As Long) As Long
        FnScanGetMrk = GetCExpressionValue("FnScanGetMrk(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetFlg(ByRef Tbl As Long) As Long
        FnScanGetFlg = GetCExpressionValue("FnScanGetFlg(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetInt(ByRef Tbl As Long) As Long
        FnScanGetInt = GetCExpressionValue("FnScanGetInt(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetLin(ByRef Tbl As Long) As Long
        FnScanGetLin = GetCExpressionValue("FnScanGetLin(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetDbl(ByRef Tbl As Long) As Long
        FnScanGetDbl = GetCExpressionValue("FnScanGetDbl(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetEch(ByRef Tbl As Long) As Long
        FnScanGetEch = GetCExpressionValue("FnScanGetEch(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetAng(ByRef Tbl As Long) As Long
        FnScanGetAng = GetCExpressionValue("FnScanGetAng(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetClr(ByRef Tbl As Long) As Long
        FnScanGetClr = GetCExpressionValue("FnScanGetClr(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetScr(ByRef Tbl As Long) As Long
        FnScanGetScr = GetCExpressionValue("FnScanGetScr(" & VarPtr(Tbl) & ")")
    End Function
    
    Function FnScanGetCoordSetup(ByRef Org As Point3d) As Long
        FnScanGetCoordSetup = GetCExpressionValue("FnScanGetCoordSetup(" & VarPtr(Org) & ")")
    End Function
#End If

Function FnScanGetPntArray(ByRef Tbl() As Point3d) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetPntArray = FnScanGetPnt(First)
    #Else
        Dim First As Long
        FnScanGetPntArray = FnScanGetPnt(First)
    #End If
    
    If FnScanGetPntArray > 0 Then
        Dim i As Long, UorPerMast As Long
        Dim Org As Point3d
        Dim Mul As Double
        Dim PCoL() As Point3dLong
        UorPerMast = FnScanGetCoordSetup(Org)
        Mul = 1 / UorPerMast
        
        ReDim Preserve Tbl(FnScanGetPntArray - 1)
        ReDim Preserve PCoL(FnScanGetPntArray - 1)
        CopyMemoryToVBA PCoL(0), First, FnScanGetPntArray * 12
        
        For i = LBound(PCoL) To UBound(PCoL)
            Tbl(i).x = Org.x + (Mul * PCoL(i).x)
            Tbl(i).y = Org.y + (Mul * PCoL(i).y)
            Tbl(i).Z = Org.Z + (Mul * PCoL(i).Z)
        Next i
    End If
End Function

Function FnScanGetClsArray(ByRef Tbl() As Byte) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetClsArray = FnScanGetCls(First)
    #Else
        Dim First As Long
        FnScanGetClsArray = FnScanGetCls(First)
    #End If
    
    If FnScanGetClsArray > 0 Then
        ReDim Preserve Tbl(FnScanGetClsArray - 1)
        CopyMemoryToVBA Tbl(0), First, FnScanGetClsArray
    End If
End Function

Function FnScanGetMrkArray(ByRef Tbl() As Byte) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetMrkArray = FnScanGetMrk(First)
    #Else
        Dim First As Long
        FnScanGetMrkArray = FnScanGetMrk(First)
    
    #End If
    
    If FnScanGetMrkArray > 0 Then
        ReDim Preserve Tbl(FnScanGetMrkArray - 1)
        CopyMemoryToVBA Tbl(0), First, FnScanGetMrkArray
    End If
End Function

Function FnScanGetFlgArray(ByRef Tbl() As Byte) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetFlgArray = FnScanGetFlg(First)
    #Else
        Dim First As Long
        FnScanGetFlgArray = FnScanGetFlg(First)
    #End If
    
    If FnScanGetFlgArray > 0 Then
        ReDim Preserve Tbl(FnScanGetFlgArray - 1)
        CopyMemoryToVBA Tbl(0), First, FnScanGetFlgArray
    End If
End Function

Function FnScanGetIntArray(ByRef Tbl() As Long) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetIntArray = FnScanGetInt(First)
    #Else
        Dim First As Long
        FnScanGetIntArray = FnScanGetInt(First)
    #End If
    
    Dim Prelim() As Integer, i As Long
    
    If FnScanGetIntArray > 0 Then
        ReDim Preserve Tbl(FnScanGetIntArray - 1)
        ReDim Preserve Prelim(FnScanGetIntArray - 1)
        CopyMemoryToVBA Prelim(0), First, FnScanGetIntArray * 2
        
        For i = LBound(Prelim) To UBound(Prelim)
            If Prelim(i) >= 0 Then
                Tbl(i) = Prelim(i)
            Else
                Tbl(i) = Prelim(i) + 65536
            End If
        Next i
    End If
End Function

Function FnScanGetLinArray(ByRef Tbl() As Long) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetLinArray = FnScanGetLin(First)
    #Else
        Dim First As Long
        FnScanGetLinArray = FnScanGetLin(First)
    #End If
    
    Dim Prelim() As Integer, i As Long
    
    If FnScanGetLinArray > 0 Then
        ReDim Preserve Tbl(FnScanGetLinArray - 1)
        ReDim Preserve Prelim(FnScanGetLinArray - 1)
        CopyMemoryToVBA Prelim(0), First, FnScanGetLinArray * 2
        
        For i = LBound(Prelim) To UBound(Prelim)
            If Prelim(i) >= 0 Then
                Tbl(i) = Prelim(i)
            Else
                Tbl(i) = Prelim(i) + 65536
            End If
        Next i
    End If
End Function

Function FnScanGetDblArray(ByRef Tbl() As Double) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetDblArray = FnScanGetDbl(First)
    #Else
        Dim First As Long
        FnScanGetDblArray = FnScanGetDbl(First)
    #End If
    
    If FnScanGetDblArray > 0 Then
        ReDim Preserve Tbl(FnScanGetDblArray - 1)
        CopyMemoryToVBA Tbl(0), First, FnScanGetDblArray * 8
    End If
End Function

Function FnScanGetEchArray(ByRef Tbl() As Byte) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetEchArray = FnScanGetEch(First)
    #Else
        Dim First As Long
        FnScanGetEchArray = FnScanGetEch(First)
    #End If
    
    If FnScanGetEchArray > 0 Then
        ReDim Preserve Tbl(FnScanGetEchArray - 1)
        CopyMemoryToVBA Tbl(0), First, FnScanGetEchArray
    End If
End Function

Function FnScanGetClrArray(ByRef Tbl() As RGB) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetClrArray = FnScanGetEch(First)
    #Else
        Dim First As Long
        FnScanGetClrArray = FnScanGetEch(First)
    #End If
        
    If FnScanGetClrArray > 0 Then
        ReDim Preserve Tbl(FnScanGetClrArray - 1)
        CopyMemoryToVBA Tbl(0), First, FnScanGetClrArray * 3
    End If
End Function

Function FnScanGetScrArray(ByRef Tbl() As Byte) As Long
    #If VBA7 Then
        Dim First As LongLong
        FnScanGetScrArray = FnScanGetScr(First)
    #Else
        Dim First As Long
        FnScanGetScrArray = FnScanGetScr(First)
    #End If
    
    If FnScanGetScrArray > 0 Then
        ReDim Preserve Tbl(FnScanGetScrArray - 1)
        CopyMemoryToVBA Tbl(0), First, FnScanGetScrArray
    End If
End Function

Пояснения -help

Немного поясню, чтобы было чуть-чуть понятнее.

Самое главное, что мы добавили в работу — это Директивы #If…Then…#Else. Именно они позволяют нам писать код один раз, но сразу для двух разных платформ. Внешне принцип действия директив #If…Then…#Else аналогичен принципу действия операторов If…Then…Else. Однако директивы #If…Then…#Else оперируют с компилируемым кодом, тогда как операторы If…Then…Else вычисляют условия во время выполнения.

Далее появляется разница в том, как мы работаем с TerraScan. Для старых версий Microstation справедливо и правильно использовать функцию GetCExpressionValue, а вот для новых мы должны отдельно объявить функции, которые находятся в tscan.dll и никак иначе.

Ну и последнее — типы данных. В данном примере мы активно используем новый тип LongLong, который может использоваться только на 64-разрядных платформах. Переменные типа LongLong хранятся как знаковые 64-разрядные (8-байтовые). Вот небольшая выдержка из MSDN:

Так как язык VBA версии 6 и более ранних версий не имеет специального типа данных для указателей и дескрипторов, им используется тип данных Long, который является 32-разрядным 4-байтным типом данных, предназначенным для ссылки на указатели и дескрипторы. Указатели и дескрипторы в 64-разрядных средах являются 8-байтными 64-разрядными числами. Эти 64-разрядные числа не могут храниться в 32-разрядных типах данных.

Ах да, ведь и методы работы с памятью мы тоже объявляем по-другому. Для 64-разрядных версий мы должны использовать ключевое слово PtrSafe. Вот что гласит MSDN по этому поводу:

Важно понимать, что просто добавление ключевого слова PtrSafe в оператор Declare означает только, что оператор Declare явно ориентирован на 64-разрядные данные, все типы данных в операторе, которые предназначены для хранения 64 разрядов (включая возвращаемые значения и параметры), все еще нуждаются в изменении, чтобы хранить 64-разрядные числа.

Заключение

В общем-то вот такими нехитрыми манипуляциями мы получаем возможность вполне адекватно работать с загруженными в TerraScan точками в среде Microstation CONNECT.

Является ли этот подход единственно и абсолютно верным? Лично я сомневаюсь и думаю, что можно сделать куда более логичное/правильное/красивое решение.

Ну и еще раз повторюсь: все эти заморочки по взаимодействию с точками посредством самописных инструментов на VBA — это все приятное упрощение выполнения небольших, но рутинных операций. Реальные большие и сложные расчеты вести с помощью подобных решений я бы не рекомендовал — для подобных вещей лучше использовать C#/C++ и инструментарий от innovoCAD.

Ну и за развлекательную часть поста сегодня у нас отвечает приглашенная звезда, лучший друг трансформеров, американский актер Шайа ЛаБаф! Встречаем!