Лазерное сканирование / Софт / Технология

Microstation, VBA и TerraScan

от Kulikov Maxim · 18.01.2017

Сегодня я хотел бы показать небольшой пример работы с лазерными данными с помощью 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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

557

558

559

560

561

562

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

593

594

595

596

597

598

599

600

601

602

603

604

605

606

607

608

609

610

611

612

613

614

615

616

617

618

619

620

621

622

623

624

625

626

627

628

629

630

631

632

633

634

635

636

637

638

639

640

641

642

643

644

645

646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

665

666

667

668

669

670

671

672

673

674

675

676

677

678

679

680

681

682

683

684

685

686

687

688

689

690

691

692

693

694

695

696

697

698

699

700

701

702

703

704

705

706

707

708

709

710

711

712

713

714

715

716

717

718

719

720

721

722

723

724

725

726

727

728

729

730

731

732

733

734

735

736

737

738

739

740

741

742

743

744

745

746

747

748

749

750

751

752

753

754

755

756

757

758

759

760

761

762

763

764

765

766

767

768

769

770

771

772

773

774

775

776

777

778

779

780

781

782

783

784

785

786

787

788

789

790

791

792

793

794

795

796

797

798

799

800

801

802

803

804

805

806

807

808

809

810

811

812

813

814

815

816

817

818

819

820

821

822

823

824

825

826

827

828

829

830

831

832

833

834

835

836

837

838

839

840

841

842

843

844

845

846

847

848

849

850

851

852

853

854

855

856

857

858

859

860

861

862

863

864

865

866

867

868

869

870

871

872

873

874

875

876

877

878

879

880

881

882

883

884

885

886

887

888

889

890

891

892

893

894

895

896

897

898

899

900

901

902

903

904

905

906

907

908

909

910

911

912

913

914

915

916

917

918

919

920

921

922

923

924

925

926

927

928

929

930

931

932

933

934

935

936

937

938

939

940

941

942

943

944

945

946

947

948

949

950

951

952

953

954

955

956

957

958

959

960

961

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

' 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 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 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

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 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

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++ позволит ускорить обработку большого количества данных, а также минимизирует количество используемой оперативной памяти, благодаря тому, что оба языка позволяют качественно работать с указателями.

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

Метки: Bentley Bentley Systems Microstation TerraScan Terrasolid VBA Лазерное сканирование Программирование Софт Технология

Kulikov Maxim

Увлекаюсь информационными и геоинформационными технологиями. Люблю полезные и не очень полезные гаджеты. Обожаю сноубординг. Ведущий инженер ЗАО "ОПТЭН Лимитед".

Вам понравится

Александр:
18.01.2017 в 23:22
С нетерпением ждем продолжения.
Ответить
Александр:
18.01.2017 в 23:55
А что за странный суффикс в названии макроса: “_borisich”?
Ответить
- Kulikov Maxim:
  27.01.2017 в 12:28
  Александр, а вы догадайтесь)
  Ответить
  - Александр:
    31.01.2017 в 22:03
    смущает транслитерация “борисич”)))
    Ответить