Microstation, VBA и TerraScan. Хитрый CONNECT
Не так давно я показывал небольшие наработки, которые позволяют без особых хлопот наладить взаимодействие с лазерными данными, загруженными в TerraScan, с использованием VBA. И там же я обещал продемонстрировать каким образом те самые наработки можно привести в такой вид, в котором они смогут работать в разных версиях Microstation.
Итак, сегодня я приведу небольшой пример, который данные возможности продемонстрирует, а дальше каждый заинтересованный сможет развить их для себя по аналогии. Показывать я буду в среде Microstation CONNECT версии 10.03.00.30. Никаких невероятных наворотов кода и тому подобной магии здесь нет — весь фокус заключается лишь в том, чтобы разделить макрос как бы на две части: первая будет работать в старых версиях Microstation (а именно там, где присутствует VBA 6), а вот вторая часть будет работать в новой версии, которая снабжена VBA 7-ой версии. Без сомнения, подобный огород можно не городить и держать две версии макросов — одну для той же v8, а другую для CONNECT, однако такой подход не всегда применим, хотя в определенной мере он является наиболее грамотным.
Дай нам коду!
Код очень прост и если вы видели предыдущий пост, то сразу заметите разницу:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 | Option Explicit #If VBA7 Then Private Declare PtrSafe Sub CopyMemoryToVBA Lib "kernel32" Alias "RtlMoveMemory" (ByRef VBALocation As Any, ByVal SourceLoc As Any, ByVal Length As LongPtr) Private Declare PtrSafe Sub CopyMemoryFromVBA Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByRef VBALocation As Any, ByVal Length As LongPtr) Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal strDest As Any, ByVal lpSource As Any, ByVal Length As LongPtr) #Else Private Declare Sub CopyMemoryToVBA Lib "kernel32" Alias "RtlMoveMemory" (ByRef VBALocation As Any, ByVal SourceLoc As Long, ByVal Length As Long) Private Declare Sub CopyMemoryFromVBA Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByRef VBALocation As Any, ByVal Length As Long) Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal strDest As Any, ByVal lpSource As Any, ByVal Length As Long) #End If #If VBA7 Then Declare PtrSafe Function FnScanGetPnt Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetCls Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetMrk Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetFlg Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetInt Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetLin Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetDbl Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetEch Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetAng Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetClr Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetScr Lib "tscan.dll" (ByRef SourceLoc As LongLong) As Long Declare PtrSafe Function FnScanGetCoordSetup Lib "tscan.dll" (ByRef Org As Point3d) As Long #Else Function FnScanGetPnt(ByRef Tbl As Long) As Long FnScanGetPnt = GetCExpressionValue("FnScanGetPnt(" & VarPtr(Tbl) & ")") End Function Function FnScanGetCls(ByRef Tbl As Long) As Long FnScanGetCls = GetCExpressionValue("FnScanGetCls(" & VarPtr(Tbl) & ")") End Function Function FnScanGetMrk(ByRef Tbl As Long) As Long FnScanGetMrk = GetCExpressionValue("FnScanGetMrk(" & VarPtr(Tbl) & ")") End Function Function FnScanGetFlg(ByRef Tbl As Long) As Long FnScanGetFlg = GetCExpressionValue("FnScanGetFlg(" & VarPtr(Tbl) & ")") End Function Function FnScanGetInt(ByRef Tbl As Long) As Long FnScanGetInt = GetCExpressionValue("FnScanGetInt(" & VarPtr(Tbl) & ")") End Function Function FnScanGetLin(ByRef Tbl As Long) As Long FnScanGetLin = GetCExpressionValue("FnScanGetLin(" & VarPtr(Tbl) & ")") End Function Function FnScanGetDbl(ByRef Tbl As Long) As Long FnScanGetDbl = GetCExpressionValue("FnScanGetDbl(" & VarPtr(Tbl) & ")") End Function Function FnScanGetEch(ByRef Tbl As Long) As Long FnScanGetEch = GetCExpressionValue("FnScanGetEch(" & VarPtr(Tbl) & ")") End Function Function FnScanGetAng(ByRef Tbl As Long) As Long FnScanGetAng = GetCExpressionValue("FnScanGetAng(" & VarPtr(Tbl) & ")") End Function Function FnScanGetClr(ByRef Tbl As Long) As Long FnScanGetClr = GetCExpressionValue("FnScanGetClr(" & VarPtr(Tbl) & ")") End Function Function FnScanGetScr(ByRef Tbl As Long) As Long FnScanGetScr = GetCExpressionValue("FnScanGetScr(" & VarPtr(Tbl) & ")") End Function Function FnScanGetCoordSetup(ByRef Org As Point3d) As Long FnScanGetCoordSetup = GetCExpressionValue("FnScanGetCoordSetup(" & VarPtr(Org) & ")") End Function #End If Function FnScanGetPntArray(ByRef Tbl() As Point3d) As Long #If VBA7 Then Dim First As LongLong FnScanGetPntArray = FnScanGetPnt(First) #Else Dim First As Long FnScanGetPntArray = FnScanGetPnt(First) #End If If FnScanGetPntArray > 0 Then Dim i As Long, UorPerMast As Long Dim Org As Point3d Dim Mul As Double Dim PCoL() As Point3dLong UorPerMast = FnScanGetCoordSetup(Org) Mul = 1 / UorPerMast ReDim Preserve Tbl(FnScanGetPntArray - 1) ReDim Preserve PCoL(FnScanGetPntArray - 1) CopyMemoryToVBA PCoL(0), First, FnScanGetPntArray * 12 For i = LBound(PCoL) To UBound(PCoL) Tbl(i).x = Org.x + (Mul * PCoL(i).x) Tbl(i).y = Org.y + (Mul * PCoL(i).y) Tbl(i).Z = Org.Z + (Mul * PCoL(i).Z) Next i End If End Function Function FnScanGetClsArray(ByRef Tbl() As Byte) As Long #If VBA7 Then Dim First As LongLong FnScanGetClsArray = FnScanGetCls(First) #Else Dim First As Long FnScanGetClsArray = FnScanGetCls(First) #End If If FnScanGetClsArray > 0 Then ReDim Preserve Tbl(FnScanGetClsArray - 1) CopyMemoryToVBA Tbl(0), First, FnScanGetClsArray End If End Function Function FnScanGetMrkArray(ByRef Tbl() As Byte) As Long #If VBA7 Then Dim First As LongLong FnScanGetMrkArray = FnScanGetMrk(First) #Else Dim First As Long FnScanGetMrkArray = FnScanGetMrk(First) #End If If FnScanGetMrkArray > 0 Then ReDim Preserve Tbl(FnScanGetMrkArray - 1) CopyMemoryToVBA Tbl(0), First, FnScanGetMrkArray End If End Function Function FnScanGetFlgArray(ByRef Tbl() As Byte) As Long #If VBA7 Then Dim First As LongLong FnScanGetFlgArray = FnScanGetFlg(First) #Else Dim First As Long FnScanGetFlgArray = FnScanGetFlg(First) #End If If FnScanGetFlgArray > 0 Then ReDim Preserve Tbl(FnScanGetFlgArray - 1) CopyMemoryToVBA Tbl(0), First, FnScanGetFlgArray End If End Function Function FnScanGetIntArray(ByRef Tbl() As Long) As Long #If VBA7 Then Dim First As LongLong FnScanGetIntArray = FnScanGetInt(First) #Else Dim First As Long FnScanGetIntArray = FnScanGetInt(First) #End If Dim Prelim() As Integer, i As Long If FnScanGetIntArray > 0 Then ReDim Preserve Tbl(FnScanGetIntArray - 1) ReDim Preserve Prelim(FnScanGetIntArray - 1) CopyMemoryToVBA Prelim(0), First, FnScanGetIntArray * 2 For i = LBound(Prelim) To UBound(Prelim) If Prelim(i) >= 0 Then Tbl(i) = Prelim(i) Else Tbl(i) = Prelim(i) + 65536 End If Next i End If End Function Function FnScanGetLinArray(ByRef Tbl() As Long) As Long #If VBA7 Then Dim First As LongLong FnScanGetLinArray = FnScanGetLin(First) #Else Dim First As Long FnScanGetLinArray = FnScanGetLin(First) #End If Dim Prelim() As Integer, i As Long If FnScanGetLinArray > 0 Then ReDim Preserve Tbl(FnScanGetLinArray - 1) ReDim Preserve Prelim(FnScanGetLinArray - 1) CopyMemoryToVBA Prelim(0), First, FnScanGetLinArray * 2 For i = LBound(Prelim) To UBound(Prelim) If Prelim(i) >= 0 Then Tbl(i) = Prelim(i) Else Tbl(i) = Prelim(i) + 65536 End If Next i End If End Function Function FnScanGetDblArray(ByRef Tbl() As Double) As Long #If VBA7 Then Dim First As LongLong FnScanGetDblArray = FnScanGetDbl(First) #Else Dim First As Long FnScanGetDblArray = FnScanGetDbl(First) #End If If FnScanGetDblArray > 0 Then ReDim Preserve Tbl(FnScanGetDblArray - 1) CopyMemoryToVBA Tbl(0), First, FnScanGetDblArray * 8 End If End Function Function FnScanGetEchArray(ByRef Tbl() As Byte) As Long #If VBA7 Then Dim First As LongLong FnScanGetEchArray = FnScanGetEch(First) #Else Dim First As Long FnScanGetEchArray = FnScanGetEch(First) #End If If FnScanGetEchArray > 0 Then ReDim Preserve Tbl(FnScanGetEchArray - 1) CopyMemoryToVBA Tbl(0), First, FnScanGetEchArray End If End Function Function FnScanGetClrArray(ByRef Tbl() As RGB) As Long #If VBA7 Then Dim First As LongLong FnScanGetClrArray = FnScanGetEch(First) #Else Dim First As Long FnScanGetClrArray = FnScanGetEch(First) #End If If FnScanGetClrArray > 0 Then ReDim Preserve Tbl(FnScanGetClrArray - 1) CopyMemoryToVBA Tbl(0), First, FnScanGetClrArray * 3 End If End Function Function FnScanGetScrArray(ByRef Tbl() As Byte) As Long #If VBA7 Then Dim First As LongLong FnScanGetScrArray = FnScanGetScr(First) #Else Dim First As Long FnScanGetScrArray = FnScanGetScr(First) #End If If FnScanGetScrArray > 0 Then ReDim Preserve Tbl(FnScanGetScrArray - 1) CopyMemoryToVBA Tbl(0), First, FnScanGetScrArray End If End Function |
Пояснения -help
Немного поясню, чтобы было чуть-чуть понятнее.
Самое главное, что мы добавили в работу — это Директивы #If…Then…#Else. Именно они позволяют нам писать код один раз, но сразу для двух разных платформ. Внешне принцип действия директив #If…Then…#Else аналогичен принципу действия операторов If…Then…Else. Однако директивы #If…Then…#Else оперируют с компилируемым кодом, тогда как операторы If…Then…Else вычисляют условия во время выполнения.
Далее появляется разница в том, как мы работаем с TerraScan. Для старых версий Microstation справедливо и правильно использовать функцию GetCExpressionValue, а вот для новых мы должны отдельно объявить функции, которые находятся в tscan.dll и никак иначе.
Ну и последнее — типы данных. В данном примере мы активно используем новый тип LongLong, который может использоваться только на 64-разрядных платформах. Переменные типа LongLong хранятся как знаковые 64-разрядные (8-байтовые). Вот небольшая выдержка из MSDN:
Так как язык VBA версии 6 и более ранних версий не имеет специального типа данных для указателей и дескрипторов, им используется тип данных Long, который является 32-разрядным 4-байтным типом данных, предназначенным для ссылки на указатели и дескрипторы. Указатели и дескрипторы в 64-разрядных средах являются 8-байтными 64-разрядными числами. Эти 64-разрядные числа не могут храниться в 32-разрядных типах данных.
Ах да, ведь и методы работы с памятью мы тоже объявляем по-другому. Для 64-разрядных версий мы должны использовать ключевое слово PtrSafe. Вот что гласит MSDN по этому поводу:
Важно понимать, что просто добавление ключевого слова PtrSafe в оператор Declare означает только, что оператор Declare явно ориентирован на 64-разрядные данные, все типы данных в операторе, которые предназначены для хранения 64 разрядов (включая возвращаемые значения и параметры), все еще нуждаются в изменении, чтобы хранить 64-разрядные числа.
Заключение
В общем-то вот такими нехитрыми манипуляциями мы получаем возможность вполне адекватно работать с загруженными в TerraScan точками в среде Microstation CONNECT.
Является ли этот подход единственно и абсолютно верным? Лично я сомневаюсь и думаю, что можно сделать куда более логичное/правильное/красивое решение.
Ну и еще раз повторюсь: все эти заморочки по взаимодействию с точками посредством самописных инструментов на VBA — это все приятное упрощение выполнения небольших, но рутинных операций. Реальные большие и сложные расчеты вести с помощью подобных решений я бы не рекомендовал — для подобных вещей лучше использовать C#/C++ и инструментарий от innovoCAD.
Ну и за развлекательную часть поста сегодня у нас отвечает приглашенная звезда, лучший друг трансформеров, американский актер Шайа ЛаБаф! Встречаем!
Hi, Please give me your help. I’m trying to reconstruct my V8i VBA for CONNECT EDITION.
I understood that I have to write «Declare» when I use the TerraScan public functions, thanks of you. So I wrote the below code in my MVBA for FnScanDeleteClass.
Public Declare PtrSafe Function FnScanDeleteClass Lib «tscan.dll» (Class As Integer, Fence As Integer) As Long
And I wrote «rt = FnScanDeleteClass(1, 0)» to use it. But pointcloud was not deleted. Can you correct my code?
And please tell me if you know the way to get a «Declare» code to use TerraScan public functions in VBA.