Microstation, VBA и TerraScan

Сегодня я хотел бы показать небольшой пример работы с лазерными данными с помощью Microstation VBA.

Предлагаемый мною способ не является единственным, но вполне пригоден для повседневного использования.

Конечно, работать с данными, загруженными в TerraScan, используя VBA — это не самый правильный и далеко не самый оптимальный путь, но так как эта среда разработки поставляется вместе с Microstation и к тому же является невероятно простой, то для многих это будет достаточно хорошим выбором, который позволит решать небольшие повседневные задачи.

Сразу скажу о минусах, с которыми мы столкнемся:

• Лишнее потребление памяти из-за невозможности работать с указателями;
• Медленная скорость работы. Однако, вполне достаточная для решения небольших задач.

Дальнейшее небольшое повествование предполагает, что вы уже знакомы с VBA, а главное знакомы с принципами работы с массивами, которые в данном случае являются залогом успеха.

Итак, поехали!

Подготовка

Для начала создаем новый макрос, который просто будет выполнять роль тестовой площадки и на котором в последствии мы сможем отладить нужные нам функции.

Новый макрос

В этом макросе нам необходимо создать новый модуль (у меня он называется FnScan, а вы можете его назвать как вашей душе угодно).

Новый модуль FnScan

На этом подготовка завершена и мы можем приступать к написанию самих функций и процедур, которые будут взаимодействовать с TerraScan.

Формируем модуль FnScan

Далее мы должны написать все необходимые нам в работе функции. Возникает вопрос: а откуда мы их вообще возьмем? Ответ прост — из официальной документации к TerraScan, которую всегда можно взять на официальном сайте.

Комментарии к функциями приведены в самом коде, поэтому тут ничего писать просто не имеет смысла. Сразу предупрежу: далеко не все функции лично я использую в работе, поэтому в них вполне могут быть ошибки, допущенные мною при переносе и различном копировании, а также допущенные авторами документации к TerraScan (пример такой ошибки я приведу в самом конце).

Итак, вот сам код модуля:

Option Explicit

' Фунцкции для загрузки приложения
Declare Function mdlSystem_findMdlDesc Lib "stdmdlbltin.dll" (ByVal nameP As String) As Long
Declare Function mdlSystem_loadMdlProgram Lib "stdmdlbltin.dll" (ByVal pathP As String, ByVal Taskidp As String, ByVal pArgument As String) As Long

' Недокументированные функции работы с памятью (позволяет получать значение переменной по указателю)
    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)

' Тип точек с целочисленными координатами
    Type Point3dLong
        x As Long
        y As Long
        Z As Long
    End Type

' Тип цвета
    Type RGB
        r As Byte
        G As Byte
        B As Byte
    End Type
     
' Типы переменных, которые необходимо знать для работы с точками
' Point3d Pnt ;         // Coordinates
' BYTE Code ;       // Classification code
' BYTE Echo ;       // Echo information
' BYTE Flag ;       // Runtime flag (view visibility)
' BYTE Mark ;       // Runtime flag
' USHORT Line ;         // Flightline number
' USHORT Intensity ; // Intensity value

' Point3d - это X, Y, Z (каждая Long, т.е. 4 байта)
' Byte в C/C++ совпадает с Byte в VBA (1 байт)
' USHORT в C/C++ не имеет аналога в VBA, длина 2 байта, для хранения можно использовать Long (0 - 65535)
' Double в C/C++ совпадает с Double в VBA (8 байт)

' Функции FnScanGet возращают количество точек и адрес требуемого значения для первой точки
' Для получения значения нужно использовать такой вызов:
' CopyMemoryToVBA Value, Tbl, 4
' Value - переменная того типа, который нужен (Byte, Long, Double)
' Tbl - указатель (адрес) где находится переменная
' 4 - размер в байтах, которые копируются в качестве значения (см. выше описание размеров переменных)
' Т.к. каждая FnScanGet возвращает количество точек, то можно получить весь массив значений
' Например:
            ' 1. для получения значения интенсивности последней точки: CopyMemoryToVBA Ints, Tbl + 2 * (Exp - 1), 2
            ' 2. для получения значения цвета (R) последней точки: CopyMemoryToVBA Clr, Tbl + 1 * (Exp - 1) * 3, 1
            ' 3. для получения значения цвета (B) последней точки: CopyMemoryToVBA Clr, Tbl + 1 * (Exp - 1) * 3 + 2, 1

'Attribute                      Always      C Data              Type Size
'Point coordinates              Yes         Point3d             12 bytes
'Time stamps                    -           double              8 bytes
'Group identifiers              -           unsigned int        4 bytes
'Normal vectors                 -           unsigned int        4 bytes
'Distances                      -           int                 4 bytes
'RGB colors                     -           RgbClr              3 bytes
'Intensity values               -           unsigned short      2 bytes
'Line numbers                   -           unsigned short      2 bytes
'Echo lengths                   -           short               2 bytes
'Parameter values               -           unsigned short      2 bytes
'Point classes                  Yes         unsigned char       1 byte
'Mark values -- run time only   Yes         unsigned char       1 byte
'Flag values -- run time only   Yes         unsigned char       1 byte
'Scanner angles                 -           char                1 byte
'Echo bits                      -           unsigned char       1 byte
'Scanner numbers                -           unsigned char       1 byte
'Echo normality values          -           unsigned char       1 byte

' Проверяем загружено ли приложение
Sub LoadApp(Appname)
    Dim Ldd As Long
    If mdlSystem_findMdlDesc(Appname) = 0 Then
        Ldd = mdlSystem_loadMdlProgram(Appname, "Null", "")
    End If
End Sub

' Координаты точек, изначально Point3d (формат TerraSolid)
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

' Функция для получения массива точек в нормальных координатах в соответствии с настройками исходного файла
Function FnScanGetPntArray(ByRef Tbl() As Point3d) As Long
    Dim First As Long
    FnScanGetPntArray = FnScanGetPnt(First)
    
    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
    Dim First As Long
    FnScanGetClsArray = FnScanGetCls(First)
    
    If FnScanGetClsArray = 0 Then
        Exit Function
    End If
    
    ReDim Preserve Tbl(FnScanGetClsArray - 1)
    CopyMemoryToVBA Tbl(0), First, FnScanGetClsArray
End Function

' Функция получения значений Mark всех загруженных точек
Function FnScanGetMrkArray(ByRef Tbl() As Byte) As Long
    Dim First As Long
    FnScanGetMrkArray = FnScanGetMrk(First)
    
    If FnScanGetMrkArray = 0 Then
        Exit Function
    End If
    
    ReDim Preserve Tbl(FnScanGetMrkArray - 1)
    CopyMemoryToVBA Tbl(0), First, FnScanGetMrkArray
End Function

' Функция получения значений Flag всех загруженных точек
Function FnScanGetFlgArray(ByRef Tbl() As Byte) As Long
    Dim First As Long
    FnScanGetFlgArray = FnScanGetFlg(First)
    
    If FnScanGetFlgArray = 0 Then
        Exit Function
    End If
    
    ReDim Preserve Tbl(FnScanGetFlgArray - 1)
    CopyMemoryToVBA Tbl(0), First, FnScanGetFlgArray
End Function

' Функция получения интенсивности всех загруженных точек
' Из-за ограничений типов данных VBA мы должны при необходимости прибавить 65536 к значению интенсивности
Function FnScanGetIntArray(ByRef Tbl() As Long) As Long
    Dim First As Long, i As Long
    Dim Prelim() As Integer
    FnScanGetIntArray = FnScanGetInt(First)
    
    If FnScanGetIntArray = 0 Then
        Exit Function
    End If
    
    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 Function

' Функция получения включений всех загруженных точек
' Из-за ограничений типов данных VBA мы должны при необходимости прибавить 65536 к значению включения
Function FnScanGetLinArray(ByRef Tbl() As Long) As Long
    Dim First As Long, i As Long
    Dim Prelim() As Integer
    FnScanGetLinArray = FnScanGetLin(First)
    
    If FnScanGetLinArray = 0 Then
        Exit Function
    End If
    
    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 Function

' Функция получения временных меток всех загруженных точек
Function FnScanGetDblArray(ByRef Tbl() As Double) As Long
    Dim First As Long
    FnScanGetDblArray = FnScanGetDbl(First)
    
    If FnScanGetDblArray = 0 Then
        Exit Function
    End If
    
    ReDim Preserve Tbl(FnScanGetDblArray - 1)
    CopyMemoryToVBA Tbl(0), First, FnScanGetDblArray * 8
End Function

' Функция получения эхо всех загруженных точек
Function FnScanGetEchArray(ByRef Tbl() As Byte) As Long
    Dim First As Long
    FnScanGetEchArray = FnScanGetEch(First)
    
    If FnScanGetEchArray = 0 Then
        Exit Function
    End If
    
    ReDim Preserve Tbl(FnScanGetEchArray - 1)
    CopyMemoryToVBA Tbl(0), First, FnScanGetEchArray
End Function

' Функция получения цвета всех загруженных точек
Function FnScanGetClrArray(ByRef Tbl() As RGB) As Long
    Dim First As Long
    FnScanGetClrArray = FnScanGetEch(First)
    
    If FnScanGetClrArray = 0 Then
        Exit Function
    End If
    
    ReDim Preserve Tbl(FnScanGetClrArray - 1)
    CopyMemoryToVBA Tbl(0), First, FnScanGetClrArray * 3
End Function

' Функция получения сканера всех загруженных точек
Function FnScanGetScrArray(ByRef Tbl() As Byte) As Long
    Dim First As Long
    FnScanGetScrArray = FnScanGetScr(First)
    
    If FnScanGetScrArray = 0 Then
        Exit Function
    End If
    
    ReDim Preserve Tbl(FnScanGetScrArray - 1)
    CopyMemoryToVBA Tbl(0), First, FnScanGetScrArray
End Function

'Классификация точек из класса в класс
'FromClass - исходные класс точек (значение 999 - все классы)
'ToClass - класс назначения (т.е. в какой класс переклассифицируем)
'Fence, если 0 - то все точки, если 1, то внутри фенса
'Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -3 если параметры неверные
Function FnScanClassifyClass(ByVal FromClass As Long, ByVal ToClass As Long, ByVal Fence As Long) As Long
    FnScanClassifyClass = GetCExpressionValue("FnScanClassifyClass(" & FromClass & "," & ToClass & "," & Fence & ")")
End Function

'Классификация Low Point
'FromClass - исходные класс точек (значение 999 - все классы)
'ToClass - класс назначения (т.е. в какой класс переклассифицируем)
'GrpCnt - максимальное количество Low Point в группе (от 1 до 99)
'Dz - минимальная разница по высоте относительно других точек (указывается в метрах)
'XyDst - радиус поиска (указывается в метрах)
'Fence, если 0 - то все точки, если 1, то внутри фенса
'Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyLow(ByVal FromClass As Long, ByVal ToClass As Long, ByVal GrpCnt As Long, ByVal dz As Double, ByVal XyDst As Double, ByVal Fence As Long) As Long
    FnScanClassifyLow = GetCExpressionValue("FnScanClassifyLow(" & FromClass & "," & ToClass & "," & GrpCnt & "," & dz & "," & XyDst & "," & Fence & ")")
End Function


' Классификация Air Point
' ClsLst - список исходных классов, например "1,7-9". Т.е. передать надо просто строку, которую потом специально конвертируем в массив символов
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' XyDst - радиус поиска (указывается в метрах)
' ReqCnt - минимальное количество точек внутри многоугольника, в котором происходит поиск
' Lim - минимальный фактор
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyAir(ByVal ClsLst As String, ByVal ToClass As Long, ByVal XyDst As Double, ByVal ReqCnt As Long, ByVal Lim As Double, ByVal Fence As Long) As Long
    FnScanClassifyAir = GetCExpressionValue("FnScanClassifyAir(" & StrPtr(StrConv(ClsLst & vbNullChar, vbFromUnicode)) & "," & ToClass & "," & XyDst & "," & ReqCnt & "," & Lim & "," & Fence & ")")
End Function

' Классификация Isolated Point
' ClsLst - список исходных классов, например "1,7-9". Т.е. передать надо просто строку, которую потом специально конвертируем в массив символов
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' Dst - радиус поиска (указывается в метрах)
' LimCnt - классифицируется, если меньше чем Lim
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyIsolated(ByVal ClsLst As String, ByVal ToClass As Long, ByVal LimCnt As Long, ByVal dst As Double, ByVal Fence As Long) As Long
    FnScanClassifyIsolated = GetCExpressionValue("FnScanClassifyIsolated(" & StrPtr(StrConv(ClsLst & vbNullChar, vbFromUnicode)) & "," & ToClass & "," & LimCnt & "," & dst & "," & Fence & ")")
End Function

' Классификация Ground Point
' FromClass - исходные класс точек (значение 999 - все классы)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' InitLow - начальные точки: 0 - текущие точки земли, 1 - нижние точки
' BldSz - максимальный размер зданий (в метрах) если InitLow = 1
' MaxAng - максимальный terrain angle (градусы)
' IterAng - iteration angle (градусы)
' IterDst - iteration distance (метры)
' Reduce - reduce iteration length?
' RedLen - when edge length < RedLen
' Stopp - stop iteration?
' StopLen - when edge length < StopLen
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyGround(ByVal FromClass As Long, ByVal ToClass As Long, ByVal InitLow As Long, ByVal BldSz As Double, _
                              ByVal MaxAng As Double, ByVal IterAng As Double, ByVal IterDst As Double, ByVal Reduce As Long, _
                              ByVal RedLen As Double, ByVal Stopp As Long, ByVal StopLen As Double, ByVal Fence As Long) As Long
    FnScanClassifyGround = GetCExpressionValue("FnScanClassifyGround(" & FromClass & "," & ToClass & "," & InitLow & "," & BldSz & "," & _
                                                                          MaxAng & "," & IterAng & "," & IterDst & "," & Reduce & "," & _
                                                                          RedLen & "," & Stopp & "," & StopLen & "," & Fence & ")")
End Function

' Классификация точек под поверхностью
' FromClass - исходные класс точек (класс земли, т.е. точек, которые дают поверхность)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' Lim - лимит
' Tol - допуск по высоте
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyBelow(ByVal FromClass As Long, ByVal ToClass As Long, ByVal Lim As Double, ByVal TolZ As Double, ByVal Fence As Long) As Long
    FnScanClassifyBelow = GetCExpressionValue("FnScanClassifyBelow(" & FromClass & "," & ToClass & "," & Lim & "," & TolZ & "," & Fence & ")")
End Function

' Классификация точек над землей
' Grd - класс земли или 1000000 + TerraModeler surface id
' MaxLen -  maximum ground triangle length
' FromClass - source class (999 for any)
' ToClass - destination class
' MinH - minimum height above ground
' MaxH - maximum height above ground
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyHgtGrd(ByVal Grd As Long, ByVal MaxLen As Double, ByVal FromClass As Long, ByVal ToClass As Long, _
                              ByVal MinH As Double, ByVal MaxH As Double, ByVal Fence As Long) As Long
    FnScanClassifyHgtGrd = GetCExpressionValue("FnScanClassifyHgtGrd(" & Grd & "," & MaxLen & "," & FromClass & "," & ToClass & "," & MinH & "," & MaxH & "," & Fence & ")")
End Function


' Классификация точек относительно нескольких классов
' Аналогичен FnScanClassifyHgtGrd, но вместо ByVal Grd As Long передается ByVal GrdLst As String
' GrdLst list of ground classes, example "2,8"
Function FnScanClassifyHgtLst(ByVal GrdLst As String, ByVal MaxLen As Double, ByVal FromClass As Long, ByVal ToClass As Long, _
                              ByVal MinH As Double, ByVal MaxH As Double, ByVal Fence As Long) As Long
    FnScanClassifyHgtLst = GetCExpressionValue("FnScanClassifyHgtLst(" & StrPtr(StrConv(GrdLst & vbNullChar, vbFromUnicode)) & "," & MaxLen & "," & FromClass & "," & ToClass & "," & MinH & "," & MaxH & "," & Fence & ")")
End Function


' Классификация точек в определенном диапазоне высот MinZ <= Z < MaxZ
' FromClass - исходные класс точек (значение 999 - все классы)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' MinZ - минимальная высота
' MaxZ - максимальная высота
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyAbsElev(ByVal FromClass As Long, ByVal ToClass As Long, ByVal MinZ As Double, ByVal MaxZ As Double, ByVal Fence As Long) As Long
    FnScanClassifyAbsElev = GetCExpressionValue("FnScanClassifyAbsElev(" & FromClass & "," & ToClass & "," & MinZ & "," & MaxZ & "," & Fence & ")")
End Function


' Классификация точек в определенном диапазоне интенсивности MinV <= Intensity < MaxV
' FromClass - исходные класс точек (значение 999 - все классы)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' MinZ - минимальная интенсивность
' MaxZ - максимальная интенсивность
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyIntensity(ByVal FromClass As Long, ByVal ToClass As Long, ByVal MinV As Double, ByVal MaxV As Double, ByVal Fence As Long) As Long
    FnScanClassifyIntensity = GetCExpressionValue("FnScanClassifyIntensity(" & FromClass & "," & ToClass & "," & MinV & "," & MaxV & "," & Fence & ")")
End Function

' Классификация точек в определенном диапазоне цветов с использованием цветовой модели HSV
' FromClass - исходные класс точек (значение 999 - все классы)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' Source color source: 0=laser, 1=ortho, 2=raw images
' Foot laser footprint diameter (m) in ortho/raw images
' Hue hue value
' Tol +- tolerance for hue
' SatMin minimum saturation
' SatMax maximum saturation
' ValMin minimum value
' ValMax maximum value
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyColor(ByVal FromClass As Long, ByVal ToClass As Long, ByVal Source As Long, ByVal Foot As Double, ByVal Hue As Long, _
                             ByVal Tol As Long, ByVal SatMin As Long, ByVal SatMax As Long, ByVal ValMin As Long, ByVal ValMax As Long, ByVal Fence As Long) As Long
    FnScanClassifyColor = GetCExpressionValue("FnScanClassifyColor(" & FromClass & "," & ToClass & "," & Source & "," & Foot & "," & Hue & "," & _
                                                                       Tol & "," & SatMin & "," & SatMax & "," & ValMin & "," & ValMax & "," & Fence & ")")
End Function


' Классификация точек в определенном диапазоне времени Beg <= Time <= End
' FromClass - исходные класс точек (значение 999 - все классы)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' BegTime - начальное время (секунды)
' EndTime - конечное время (секунды)
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyTime(ByVal FromClass As Long, ByVal ToClass As Long, ByVal BegTime As Double, ByVal EndTime As Double, ByVal Fence As Long) As Long
    FnScanClassifyTime = GetCExpressionValue("FnScanClassifyTime(" & FromClass & "," & ToClass & "," & BegTime & "," & EndTime & "," & Fence & ")")
End Function

' Classify model keypoints which produce a triangulated surface model of given accuracy.
' ClsLst - исходные класс точек, example "2,14"
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' InitDst - initial sampling distance (m)
' Above - distance points may be above model (m)
' Below - distance points may be below model (m)
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyModelKey(ByVal ClsLst As String, ByVal ToClass As Long, ByVal InitDst As Double, ByVal Above As Double, ByVal Below As Double, ByVal Fence As Long) As Long
    FnScanClassifyModelKey = GetCExpressionValue("FnScanClassifyModelKey(" & StrPtr(StrConv(ClsLst & vbNullChar, vbFromUnicode)) & "," & ToClass & "," & InitDst & "," & Above & "," & Below & "," & Fence & ")")
End Function

' Classify contour keypoints which produce a triangulated surface suitable for generating contours.
' ClsLst - исходные класс точек, example "2,14"
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' Interval - contour interval (m)
' Init - initial sampling distance (m)
' Lim - limit for classification (1=accure/many points, 100=pretty/few points)
' Peaks - 0=no, 1=keep peaks and pits
' PeakArea - minimum area (m2) for peak to keep
' PitArea - minimum area (m2) for pit to keep
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyContourKey(ByVal ClsLst As String, ByVal ToClass As Long, ByVal Interval As Double, ByVal Init As Double, _
                                  ByVal Lim As Long, ByVal Peaks As Long, ByVal PeakArea As Double, ByVal Fence As Long) As Long
    FnScanClassifyContourKey = GetCExpressionValue("FnScanClassifyContourKey(" & StrPtr(StrConv(ClsLst & vbNullChar, vbFromUnicode)) & "," & ToClass & "," & Interval & "," & Init & "," & _
                                                                                 Lim & "," & Peaks & "," & PeakArea & "," & Fence & ")")
End Function

' Классификация точек относительно ВЫДЕЛЕННОГО Centerline.
' ClsLst - исходные класс точек, example "2,14"
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' Cmp - compare with 0=any line, 1=closest line
' Side - -1=left, 0=either, 1=right side
' OffMin - minimum xy offset from element (m)
' OffMax - maximum xy offset from element (m)
' UseDz - if true, use dz from alignment
' DzMin - minimum dz value
' DzMax - maximum dz value
' UseDst - if true, use distance from closest vertex
' DstMin - minimum longitudinal distance to vertex
' DstMax - minimum longitudinal distance to vertex
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если прервана
' Вернет -3 если параметры неверные
Function FnScanClassifyCtrline(ByVal ClsLst As String, ByVal ToClass As Long, ByVal Cmp As Long, _
                               ByVal Side As Long, ByVal OffMin As Double, ByVal OffMax As Double, _
                               ByVal UseDz As Long, ByVal DzMin As Double, ByVal DzMax As Double, _
                               ByVal UseDst As Long, ByVal DstMin As Double, ByVal DstMax As Double) As Long
    FnScanClassifyCtrline = GetCExpressionValue("FnScanClassifyCtrline(" & StrPtr(StrConv(ClsLst & vbNullChar, vbFromUnicode)) & "," & ToClass & "," & Cmp & "," & _
                                                                           Side & "," & OffMin & "," & OffMax & "," & _
                                                                           UseDz & "," & DzMin & "," & DzMax & "," & _
                                                                           UseDst & "," & DstMin & "," & DstMax & "," & ")")
End Function


' Классификация точек по значению Echo
' FromClass - исходные класс точек (значение 999 - все классы)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' Echo - значение Echo
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Valid values for Echo parameter are:
' 0 only Echo
' 1 first of many
' 2 intermediate
' 3 last of many
' 11 any first (only echo or first of many)
' 13 any last (only echo or last of many)
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -3 если параметры неверные
Function FnScanClassifyEcho(ByVal FromClass As Long, ByVal ToClass As Long, ByVal Echo As Long, ByVal Fence As Long) As Long
    FnScanClassifyEcho = GetCExpressionValue("FnScanClassifyEcho(" & FromClass & "," & ToClass & "," & Echo & "," & Fence & ")")
End Function


' Классификация точек по направлению сканирования или флагу edge
' FromClass - исходные класс точек (значение 999 - все классы)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' Direction - 0=negative direction, 1=positive direction, 2=edge
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -2 если нет направления сканирования
' Вернет -3 если параметры неверные
Function FnScanClassifyDirection(ByVal FromClass As Long, ByVal ToClass As Long, ByVal Direction As Long, ByVal Fence As Long) As Long
    FnScanClassifyDirection = GetCExpressionValue("FnScanClassifyDirection(" & FromClass & "," & ToClass & "," & Direction & "," & Fence & ")")
End Function

' Classify points which are hits on building roofs.
' GrdClass - класс земли
' FromClass - исходный класс (high vegetation)
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' MinArea - минимальная площадь здания (m2)
' Tol -  plane tolerance (m)
' UseEcho - use echo information?
' Fence, если 0 - то все точки, если 1, то внутри фенса
' Возвращает количество классифицированных точек (0...n)
' Вернет -1 если фенс не найден, но при этом заказано именно внутри фенса
' Вернет -3 если параметры неверные
Function FnScanClassifyBuilding(ByVal GrdClass As Long, ByVal FromClass As Long, ByVal ToClass As Long, ByVal MinArea As Double, ByVal Tol As Double, ByVal UseEcho As Long, ByVal Fence As Long) As Long
    FnScanClassifyBuilding = GetCExpressionValue("FnScanClassifyBuilding(" & GrdClass & "," & FromClass & "," & ToClass & "," & MinArea & "," & Tol & "," & UseEcho & "," & Fence & ")")
End Function

' Классификация точек внутри шейпа, который находится в заданном слое текущего DGN или референсе
' ClsLst - исходные класс точек, example "2,14"
' ToClass - класс назначения (т.е. в какой класс переклассифицируем)
' Lvl Level
' ByClr filter by color?
' Clr -Color
' ByWgt filter by weight?
' Wgt -Weight
' BySty filter by style?
' Sty -Style
' Dgn 0=active design and references, 1=active design file, 2=reference files
' Возвращает количество классифицированных точек (0...n)
' Вернет -2 если out of memory.
Function FnScanClassifyShapes(ByVal ClsLst As String, ByVal ToClass As Long, ByVal Lvl As Long, ByVal Clr As Long, _
                                ByVal ByWgt As Long, ByVal Wgt As Long, ByVal BySty As Long, ByVal Sty As Long, ByVal Expand As Double, ByVal Dgn As Long) As Long
    FnScanClassifyShapes = GetCExpressionValue("FnScanClassifyShapes(" & StrPtr(StrConv(ClsLst & vbNullChar, vbFromUnicode)) & "," & FromClass & "," & Lvl & "," & Clr & "," & _
                                                                         ByWgt & "," & Wgt & "," & BySty & "," & Sty & "," & Expand & "," & Dgn & ")")
End Function

' Классификация точек, у которых Mark = 1
' Return number of classified points.
Function FnScanClassifyMarked(ByVal FromClass As Long, ByVal ToClass As Long) As Long
    FnScanClassifyMarked = GetCExpressionValue("FnScanClassifyMarked(" & FromClass & "," & ToClass & ")")
End Function

' Удаление точек по классу
' Class source class to delete
' Fence 0=all points, -1=outside fence, 1=inside fence
' Return number of points deleted (0...n).
' Return -1 if no fence defined (and Fence was nonzero).
Function FnScanDeleteClass(ByVal Class As Long, ByVal Fence As Long) As Long
    FnScanDeleteClass = GetCExpressionValue("FnScanDeleteClass(" & Class & "," & Fence & ")")
End Function

' Удаление точек по включению
' Line flightline or measurement to delete
' Fence 0=all points, -1=outside fence, 1=inside fence
' Return number of points deleted (0...n).
' Return -1 if no fence defined (and Fence was nonzero).
Function FnScanDeleteLine(ByVal Line As Long, ByVal Fence As Long) As Long
    FnScanDeleteLine = GetCExpressionValue("FnScanDeleteLine(" & Line & "," & Fence & ")")
End Function

' Трансформация точек
' FromClass - исходные класс точек (значение 999 - все классы)
' Name - название трансформации в настройках TerraScan
' Fence 0=all points, 1=inside fence
' Return number of points deleted (0...n).
' Return -1 if no fence defined (and Fence was nonzero).
' Return -2 if was aborted.
' Return -3 if invalid parameters.
' Return -4 if transformation was not found.
Function FnScanTransform(ByVal Class As Long, ByVal Name As String, ByVal Fence As Long) As Long
    FnScanTransform = GetCExpressionValue("FnScanTransform(" & Line & "," & StrPtr(StrConv(Name & vbNullChar, vbFromUnicode)) & "," & Fence & ")")
End Function

' Перерисовка всех окон, на которых могут быть отображены точки
' Всегда возвращает 1
Function FnScanUpdateViews() As Long
    FnScanUpdateViews = GetCExpressionValue("FnScanUpdateViews()")
End Function

' Сортировка загруженных точек
' 0 increasing easting
' 1 decreasing northing
' 2 increasing easting
' 3 decreasing northing
' 4 increasing time stamp
' 19 MDL Public Functions
' Return 1 if points were sorted.
' Return 0 if nothing was done.
Function FnScanSort(ByVal By As Long) As Long
    FnScanSort = GetCExpressionValue("FnScanSort(" & By & ")")
End Function

' Output points to a file.
' File - Output file name. If it contains string "######", that string will be replaced by active block number.
'        Active project directory will be used if File does not include a directory specification.
'        If File contains string "#name", that string will replaced by active file name.
'        In that case, File should always include directory and extension such as "c:\output\#name.grd".
' ClsLst - list of classes to output, example "1,7-9"
' Fmt - Format of output file.
' Delim - Delimiter (0=space, 1=tabulator, 2=comma).
' Trans - Name of transformation in TerraScan settings.
' Pass - zero or "" for none.
' Append - If true, add to end of a possibly existing file.
' Fence - 0=all points, 1=inside fence
' Format can be:
' 1 X Y Z
' 2 Class X Y Z
' 3 X Y Z Intensity
' 5 Class X Y Z Intensity
' 7 TerraScan binary 8 bit line numbers
' 8 TerraScan binary 16 bit line numbers
' 13 EarthData binary
' 23 Grass Sites format
' 200+ User defined file format
' Return number of points written.
' Return -1 if no fence defined (and Fence was nonzero).
' Return -2 if failed to write to file.
' Return -3 if invalid parameters.
' Return -4 if transformation was not found.
Function FnScanOutput(ByVal File As String, ByVal ClsLst As String, ByVal Fmt As Long, ByVal Delim As Long, ByVal nDelim As Long, ByVal Trans As String, ByVal Append As Long, ByVal Fence As Long, ByVal Block As Long, ByVal Val As Long) As Long
    FnScanOutput = GetCExpressionValue("FnScanOutput(" & StrPtr(StrConv(File & vbNullChar, vbFromUnicode)) & "," & _
                                                         StrPtr(StrConv(ClsLst & vbNullChar, vbFromUnicode)) & "," & _
                                                         Fmt & "," & _
                                                         Delim & "," & _
                                                         nDelim & "," & _
                                                         StrPtr(StrConv(Trans & vbNullChar, vbFromUnicode)) & "," & _
                                                         Append & "," & _
                                                         Fence & "," & _
                                                         Block & "," & Val & ")")
End Function

' Output points to a file based on flightline number. This will generate multiple output files if Line == -1 in which case one output file will be generated for every flightline.
' File - Output file name. If File contains string "#line", that string will be replaced by flight line number.
'        Active project directory will be used if File does not include a directory specification.
'        Line Line to output. Pass -1 for all lines and use "#line" as part of file name.
' Class - Class of points to output. Pass 999 for all points.
' Fmt - Format of output file, see FnScanOutput().
' Delim - Delimiter (0=space, 1=tabulator, 2=comma).
' Trans - Name of transformation in TerraScan settings. Pass zero or "" for none.
' Append - If true, add to end of a possibly existing file.
' Return number of points written.
' Return -3 if invalid parameters.
' Return -4 if transformation was not found.
Function FnScanOutputLine(ByVal File As String, ByVal Line As Long, ByVal Class As Long, ByVal Fmt As Long, ByVal Delim As Long, _
                          ByVal Trans As String, ByVal Append As Long) As Long
    FnScanOutputLine = GetCExpressionValue("FnScanOutputLine(" & StrPtr(StrConv(File & vbNullChar, vbFromUnicode)) & "," & Line & "," & Class & "," & _
                                                                 Fmt & "," & Delim & "," & StrPtr(StrConv(Trans & vbNullChar, vbFromUnicode)) & "," & Append & ")")
End Function

' Return information about the active project. Set:
' Type - project type: 0=airborne, 1=ground based
' Fmt - storage format: 0=TerraScan binary, 1=EarthData
' Описание FMT в документации устаревшее. По моим тестам так:
' 0 - Bin 8 bit
' 1 - Bin 16 bit
' 2 - EarthData EEBN и EBN
' 3 - LAS 1.0
' 4 - LAS 1.1
' 5 - LAS 2.0
' 6 - FastBin
' Dir - data file directory
' Return number of blocks (0 - n).
' Return -1 if no active project.
' Параметры передаем как ByRef, т.к. функция их меняет!
' Сложность данной функции в том, она должна заполнить динамический массив символов Dir (char *Dir)
' В VBA мы такое проделать не можем, т.к. мы не знаем какой длины в итоге мы получили строку, т.е. мы понятия не имеем сколько нам надо байт считать по указателю
' Как выход забивать исходную строку Dir спецсимволами (например 10 000 символов), недопустимыми в названии путей и потом удалять лишее
Function FnScanProjectInfo(ByRef Typep As Long, ByRef Fmt As Long, ByRef Dir As String) As Long
    Dim i As Long
    Dim bytArr() As Byte
    bytArr = StrConv(Dir & vbNullChar, vbFromUnicode)
    
    FnScanProjectInfo = GetCExpressionValue("FnScanProjectInfo(" & VarPtr(Typep) & "," & VarPtr(Fmt) & "," & VarPtr(bytArr(0)) & ")")
    
    Dir = ""
    For i = LBound(bytArr) To UBound(bytArr)
        Dir = Dir + Chr(bytArr(i))
    Next i
End Function

' Return information about project block index Ind. Set:
' Vrt[] boundary vertices (up to 41)
' File binary file name including full path
' Return number of boundary vertices (0 - 41).
' Return -1 if invalid index or no active project.
' Индексация блоков с 0
' Vrt() - массив не динамический, а статический на 5000 элементов. Далее необходимо считать то количество элементов массива, сколько вернет функция в виде ответа
' File - аналогично DIR предыдущей функции FnScanProjectInfo
Function FnScanProjectBlock(ByRef Vrt() As Point3d, ByRef File As String, ByVal Ind As Long) As Long
    Dim i As Long
    Dim bytArr() As Byte
    bytArr = StrConv(File & vbNullChar, vbFromUnicode)
    
    FnScanProjectBlock = GetCExpressionValue("FnScanProjectBlock(" & VarPtr(Vrt(0)) & "," & VarPtr(bytArr(0)) & "," & Ind & ")")
    
    File = ""
    For i = LBound(bytArr) To UBound(bytArr)
        File = File + Chr(bytArr(i))
    Next i
End Function

' Create lattice model from laser points in class Class and write that to file File.
' File - Output file name. Active project directory will be used if File does not include a directory specification.
'        If it contains string "######" or "#block", that string will be replaced by active block number.
'        If File contains string "#name", that string will be replaced by active file name.
'Class - Class of points to output. Pass 999 for all points.
'Elev - 0=lowest, 1=average, 2=highest hit, 3=triangle model
'Step - Grid step size (m).
'Len - Number of gap pixels to fill if Elev != 3. Maximum triangle length if Elev == 3.
'Fmt - Format of output file.
'UnitZ - Unit of Z values: 0=uor, 1=mm, 2=cm, 3=dm, 4=m. Used only with Intergraph and Raw binary formats.
'CrdBlk - 0=no coordinate block, nonzero=output. Used only with Intergraph format.
'Out - Value to output in undefined area. Pass NULL to skip. Used only with ArcInfo and Xyz text formats.
' Format can be:
' 0 Intergraph Grd
' 5 Raw binary 16 bit
' 6 Raw binary 32 bit
' 7 Raw binary 64 bit double
' 8 ArcInfo GRIDASCII
' 9 Xyz Text
' Return 1 on success.
' Return 0 if no source points.
' Return -2 if failed to write to file.
Function FnScanExportLattice(ByVal File As String, ByVal Class As Long, ByVal Elev As Long, ByVal Step As Double, ByVal lenn As Double, ByVal Fmt As Long, _
                             ByVal UnitZ As Long, ByVal CrdBlk As Long, ByVal Out As String) As Long
    FnScanExportLattice = GetCExpressionValue("FnScanExportLattice(" & StrPtr(StrConv(File & vbNullChar, vbFromUnicode)) & "," & Class & "," & Elev & "," & _
                                                                       Step & "," & lenn & "," & Fmt & "," & UnitZ & "," & CrdBlk & "," & _
                                                                       StrPtr(StrConv(Out & vbNullChar, vbFromUnicode)) & ")")
End Function

' Read points from file File into RAM.
' File Full path of input file(s). Multiple file names should be separated by '\n'
' First - Class for non-last echos (if not in input)
' Last - Class for last echos (if not in input)
' Line - Flightline number (if not in input)
' Inc - When flightline number is incremented. 0=never, 2=new file, 3=new file name, 4=new dir
' Trans - Name of transformation in TerraScan settings. Pass zero or "" for none
' Fence - 0=all points, 1=inside fence
' Every - 0=every, 1=every, n=every n:th
' Return number of points found.
' Return -2 if failed to open or recognize format of first file.
' Return -3 if invalid parameters.
' Return -4 if transformation was not found.
' Return -5 if out of memory.
Function FnScanRead(ByVal File As String, ByVal First As Long, ByVal Last As Long, ByVal Line As Long, ByVal Inc As Long, ByVal Trans As String, ByVal Fence As Long, ByVal Every As Long) As Long
    FnScanRead = GetCExpressionValue("FnScanRead(" & StrPtr(StrConv(File & vbNullChar, vbFromUnicode)) & "," & First & "," & Last & "," & _
                                                     Line & "," & Inc & "," & StrPtr(StrConv(Trans & vbNullChar, vbFromUnicode)) & "," & Fence & "," & Every & ")")
End Function

' Smoothen surface by adjusting point elevations. moving points points by adjusting elevations by a maximum of
' ModLst - classes to smoothen, example "1,7-9"
' UpCm - maximum movement up (cm)
' DnCm - maximum movement down (cm)
' FixLst - immovable classes to include in surface, "5-6"
' Fence - 0=all points, -1=outside fence, 1=inside fence
' Return 1 if points were adjusted.
' Return 0 if nothing was done.
' Return -2 if out of memory.
Function FnScanSmoothen(ByVal ModLst As String, ByVal UpCm As Long, ByVal DnCm As Long, ByVal FixLst As String, ByVal Fence As Long) As Long
    FnScanSmoothen = GetCExpressionValue("FnScanSmoothen(" & StrPtr(StrConv(ModLst & vbNullChar, vbFromUnicode)) & "," & UpCm & "," & DnCm & "," & _
                                                             StrPtr(StrConv(FixLst & vbNullChar, vbFromUnicode)) & "," & Fence & ")")
End Function

' Thin data set by removing points close to another point. Point can be removed if it is within Dxy horizontal distance and Dz elevation difference from another point.
' Class - source class to thin (999 for any)
' Keep point to keep in a group: 0=highest,1=lowest,2=central,3=create average
' Dxy - xy distance limit
' Dz - dz limit
' Fence - 0=all points, -1=outside fence, 1=inside fence
' Return number of points removed (0...n).
' Return -1 if no fence defined (and Fence was nonzero).
' Return -3 if invalid parameters.
Function FnScanThinPoints(ByVal Class As Long, ByVal Keep As Long, ByVal Dxy As Double, ByVal dz As Double, ByVal Fence As Long) As Long
    FnScanThinPoints = GetCExpressionValue("FnScanThinPoints(" & Class & "," & Keep & "," & Dxy & "," & dz & "," & Fence & ")")
End Function

' Cut points from overlapping flightlines by either flightline quality or by offset from trajectory.
' ClsLst - List of coverage classes, example "0-255"
' Action - Action: 0=add constant, 1=classify, 2=delete
' Val - If Action == 0, value to add to class
'       If Action == 1, class to classify to
'       If Action == 2, ignored
' Quality - 0=no, 1=cut by trajectory quality
' Gap - radius of empty area to consider a gap
' Offset 0=no, 1=cut by offset
' Keep - minimum corridor to keep (degrees)
' Return number of points affected (0...n).
' Return -3 if invalid parameters.
' Return -4 if no trajectories.
Function FnScanCutOverlap(ByVal ClsLst As String, ByVal Action As Long, ByVal Val As Long, ByVal Quality As Long, ByVal Gap As Double, ByVal Offset As Long, ByVal Keep As Long) As Long
    FnScanCutOverlap = GetCExpressionValue("FnScanCutOverlap(" & StrPtr(StrConv(ClsLst & vbNullChar, vbFromUnicode)) & "," & Action & "," & Val & "," & Quality & "," & Gap & "," & Offset & "," & Keep & ")")
End Function

' Adjust laser points using an angular change to the vector from scanner position to the point.
' Line Line to adjust. Pass -1 for all lines.
' Fix Coordinate axis to fix: 1=z, 2=xy, 3=xyz
' Input Angle unit used: 0=degrees, 1=radians, 2=ratio
' Head Heading correction angle
' Roll Roll correction angle
' Pitch Pitch correction angle
' Div Angle divider corresponding to full circle.
' Used if Input == 2.
' Return number of points adjusted.
' Return -1 if no trajectories loaded.
Function FnScanAdjustAngles(ByVal Line As Long, ByVal Fixx As Long, ByVal Inputt As Long, ByVal Head As Double, ByVal Roll As Double, ByVal Pitch As Double, ByVal Div As Double) As Long
    FnScanAdjustAngles = GetCExpressionValue("FnScanAdjustAngles(" & Line & "," & Fixx & "," & Inputt & "," & Head & "," & Roll & "," & Pitch & "," & Div & ")")
End Function

' Функция FnScanMarkAll помечает все загруженные точки заданым значением Mark
Function FnScanMarkAll(ByVal MarkVal As Long) As Long
    FnScanMarkAll = GetCExpressionValue("FnScanMarkAll(" & MarkVal & ")")
End Function

' Функция FnScanMarkFence помечает точки внутри фенса значением 1, вне фенса значением 0
' Fst и Lst являются указателями на первую и последнюю точку внутри фенса
' Возвращает 1 если получилось, 0 если ошибка
Function FnScanMarkFence(ByRef Fst As Long, ByRef Lst As Long) As Long
    FnScanMarkFence = GetCExpressionValue("FnScanMarkFence(" & VarPtr(Fst) & "," & VarPtr(Lst) & ")")
End Function

' Fill option button with class names.
' Return 0 always.
' ВНИМАНИЕ: функция не работает! Надо реализовывать структуру rawitemhdr, которая описана c:\Program Files (x86)\Bentley\MicroStation\mdl\include\dlogitem.h
Function FnScanClassOption(ByRef Raw As Long) As Long
    FnScanClassOption = GetCExpressionValue("FnScanClassOption(" & VarPtr(Sel) & ")")
End Function

'Fill string list with:
'- class numbers and names if Nbr is true
'- class names only if Nbr is zero
'Return number of classes.
' ВНИМАНИЕ: функция не работает! Lst имеет тип StringList, аналог которого надо найти в VBA
Function FnScanClassList(ByRef Lst() As String, ByVal Nbr As Long) As Long
    FnScanClassList = GetCExpressionValue("FnScanClassList(" & VarPtr(Lst(0)) & "," & Nbr & ")")
End Function

' Функция FnScanSelectClasses сначала показывает форму со списком доступных классов
' В качестве Sel передается 0-ой элемент готового статического массива на 256 элементов (Dim Sel(255) As Byte)
' Возвращает количество выделенных классов и заполненный массив (0 - не выделен, 1 - выделен)
' Если нажата кнопка Cancel, то вернет -1
Function FnScanSelectClasses(ByRef Sel As Byte) As Long
    FnScanSelectClasses = GetCExpressionValue("FnScanSelectClasses(" & VarPtr(Sel) & ")")
End Function

' Функция FnScanSave сохраняет загруженные точки во временный файл в бинарном формате
' Возвращает 1 если запись удалась, 0 - если произошла ошибка
' ВНИМАНИЕ: StrPtr нам даст адрес переменной. Но так как сама функция требует на входе char *Path (массив символов), то надо также сделать преобразование
' в байтовый массив, аналог строки LPSTR (ANSI  с символом Char(0) в конце)
' Данное решение найдено тут: http://www.sql.ru/forum/505264-2/peredacha-char-cherez-vba-v-dll
Function FnScanSave(ByVal Path As String) As Long
    FnScanSave = GetCExpressionValue("FnScanSave(" & StrPtr(StrConv(Path & vbNullChar, vbFromUnicode)) & ")")
End Function

' Функция перезагружает точки из временного файла
' Возвращает 1 если удалось, 0 если ошибка чтения файла,
' -1 - если у нас в памяти уже есть точки, -2 - если ошибка Out of memory (короче не хватает памяти для загрузки)
' Что самое интересное: у нас открыт TerraScan, точек нет. Загружаем точки этой функцией - в памяти они есть, но они не отображаются (заведомо находимся там
' где точки находятся. Fit View помогает отобразить точки, но зум не работает)
Function FnScanReload(ByVal Path As String) As Long
    FnScanReload = GetCExpressionValue("FnScanReload(" & StrPtr(StrConv(Path & vbNullChar, vbFromUnicode)) & ")")
End Function

' Функцию FnScanPreFree необходимо запускать перед FnScanFreeTable
' Запрашивает пользователя о желании сохранить модифицированные данные перед закрытием
' Возвращает 1 если были сохранены (нажали кнопку Yes)
' Возвращает 0 если точек нет или они не были модифицированны
Function FnScanPreFree() As Long
    FnScanPreFree = GetCExpressionValue("FnScanPreFree()")
End Function

' Функция FnScanFreeTable освобождает аллокированную под точки память
' Никаких вопросов пользователю не задает!!!
' Параметров нет, всегда возвращает 1
Function FnScanFreeTable() As Long
    FnScanFreeTable = GetCExpressionValue("FnScanFreeTable()")
End Function

' Find laser point closest to point Cp which is within distance R of point Cp when drawn in view Vw.
' Fp Point where the coordinates will be stored.
' Class Class of points to output. Pass 999 for all points.
' Cp Point at which to search.
' R Search radius (m).
' Vw View index for rotation of search (pass -1 for top view search logic).
' Return index of point if found (0,1,2,...).
' Return -1 if no point found.
Function FnScanFindClosest(ByRef Fp As Point3d, ByVal Class As Long, ByRef CP As Point3d, ByVal r As Double, ByVal Vw As Long) As Long
    FnScanFindClosest = GetCExpressionValue("FnScanFindClosest(" & VarPtr(Fp) & "," & Class & "," & VarPtr(CP) & "," & r & "," & Vw & ")")
End Function

Если вы не просто копируете, а пытаетесь понять смысл написанного, то вам могут помочь мои комментарии. Хотя ничего особенно инновационного в них нет и в большинстве своем они содержат банальный перевод описания функций из официальной документации.

Пишем тестовую программу

Ну а теперь пришла пора протестировать несколько наших функций, чтобы убедиться, что приведенный код работает. Я буду проводить тестирование в среде Microstation v8. В среде Microstation CONNECT приведенный подход не работает, поэтому можете даже не пытаться. В следующий раз я приведу пример того какие доработки необходимо произвести, чтобы получить универсальный макрос, который будет работать во всех версиях Microstation.

Создадим форму с 5 кнопками, к каждой из которых в дальнейшем мы привяжем свою функцию.

Форма тестового макроса

Теперь давайте последовательно для каждой кнопки пропишем свои действия:

Сколько точек в классе №3

Private Sub CommandButton1_Click()
    ' Объявим массив для хранения значений классов ТЛС
    Dim PCl() As Byte
    
    ' Импортируем информацию о загруженных точках из TerraScan
    If FnScanGetClsArray(PCl) = 0 Then
        MsgBox "В TerraScan не загружены лазерные данные или их формат некорректный", vbCritical
        Exit Sub
    End If
    
    ' Посчитаем количество ТЛС в классе №3 в массиве
    Dim i As Long, Count As Long
    
    Count = 0
    
    For i = LBound(PCl) To UBound(PCl)
        If PCl(i) = 3 Then
            Count = Count + 1
        End If
    Next i
    
    ' Выведем результат
    MsgBox "Количество ТЛС в классе №3: " & Count & " шт."
End Sub

Максимальный номер включения

Private Sub CommandButton2_Click()
    ' Объявим массив для хранения значений включений ТЛС
    Dim PFl() As Long
    
    ' Импортируем информацию о загруженных точках из TerraScan
    If FnScanGetLinArray(PFl) = 0 Then
        MsgBox "В TerraScan не загружены лазерные данные или их формат некорректный", vbCritical
        Exit Sub
    End If
    
    ' Найдем максмальный номер включения
    Dim i As Long, MaxLin As Long
    
    MaxLin = 0
    
    For i = LBound(PFl) To UBound(PFl)
        If PFl(i) > MaxLin Then
            MaxLin = PFl(i)
        End If
    Next i
    
    ' Выведем результат
    MsgBox "Максимальный номер включения: " & MaxLin
End Sub

Классификация внутри контура

Private Sub CommandButton3_Click()
    ' Проводим классификацию из класса 2 в класс 8 внутри фенса
    Dim Ret As Long
    Ret = FnScanClassifyClass(2, 8, 1)

    ' Выводим отчет о проведенной классификации
    If Ret >= 0 Then
        MsgBox "Классифицировано " & Ret & " ТЛС"
    ElseIf Ret = -1 Then
        MsgBox "Не найден фенс", vbCritical
    ElseIf Ret = -3 Then
        MsgBox "Неверно заданы параметры классификации", vbCritical
    End If
End Sub

Удаление класса №2

Private Sub CommandButton4_Click()
    ' Удалим точки класса №2 вне заданного контура
    Dim Ret As Long
    Ret = FnScanDeleteClass(2, -1)
    
    ' Выводим отчет о проведенном удалении
    If Ret >= 0 Then
        MsgBox "Удалено " & Ret & " ТЛС"
    ElseIf Ret = -1 Then
        MsgBox "Не найден фенс", vbCritical
    End If
End Sub

Сохранение в новый файл

Private Sub CommandButton5_Click()
    Dim Ret As Long
    Ret = FnScanOutput("D:/TestBin.bin", "0-255", 8, 0, 3, "", -1, 0, 0, 0)

    Select Case Ret:
        Case Is >= 0
            MsgBox "Сохранено " & Ret & " ТЛС"
        Case -1
            MsgBox "Не найден фенс", vbCritical
        Case -2
            MsgBox "Ошибка записи в файл", vbCritical
        Case -3
            MsgBox "Неправильные параметры", vbCritical
        Case -4
            MsgBox "Не найдена трансформация", vbCritical
    End Select
End Sub

Вот на эту функцию прошу обратить более пристальное внимание. Если вы посчитаете количество параметров, передаваемых в функцию, то заметите, что их количество не совпадает с тем, которое указано в документации. Это еще одна причина почему не стоит 100% доверять документации: определенные вещи в ней могут быть неактуальными и по меньшей мере запутывать пользователя.
Если какая-то функция не будет работать и будет выдавать ошибку, то можете для начала посмотреть наличие этой функции в родных макросах TerraScan и проверить достаточное ли количество параметров передаете и в том ли виде нужно передавать тот или иной параметр.

Неверное количество параметров

Заключение

Вот такое вот краткое описание возможностей взаимодействия TerraScan и Microstation посредством VBA. Надеюсь мое объяснение и небольшие примеры помогут вам понять суть и основы данного взаимодействия и вы сможете применять данные наработки в своей ежедневной работе.
В дальнейшем я покажу как реализовать тоже самое, но с использованием C# и инструментов от InnovoCAD, о которых мы говорили ранее (они как раз недавно выпустили новые версии своих инструментов).
Использование в работе C# или C++ позволит ускорить обработку большого количества данных, а также минимизирует количество используемой оперативной памяти, благодаря тому, что оба языка позволяют качественно работать с указателями.

На этом всё и всем всего!