<CommandMethod("MyGroup", "Export_tochek_tekstov", "Export_tochek_tekstov", CommandFlags.Modal + CommandFlags.UsePickSet)>
Public Sub Export_tochek_tekstov()
Dim acBlkTbl As BlockTable 'объявляем переменные для базы с примитивами чертежа
Dim acBlkTblRec As BlockTableRecord
Dim AllTXT, AllPT As SelectionSet
'______создаем фильтры выбора для всех точек в чертеже____________________________________
Dim PTtv As TypedValue() = New TypedValue(0) {}
PTtv.SetValue(New TypedValue(CInt(DxfCode.Start), "POINT"), 0)
Dim PTfilter As SelectionFilter = New SelectionFilter(PTtv)
Dim PTresult As PromptSelectionResult = ed.SelectAll(PTfilter) '___________выбираются все точки в чертеже
If PTresult.Status = PromptStatus.OK Then
AllPT = PTresult.Value
ed.WriteMessage(vbCrLf & "В чертеже обнаружено " & AllPt.Count.ToString & " точек для обработки")
Else
ed.WriteMessage(vbCrLf & "В чертеже отсутствуют 3-д точки" & vbCrLf)
Exit Sub
End If
'________________________________________________________________________
'______создаем фильтры выбора всех текстов в чертеже____________________________________
Dim TXTtv As TypedValue() = New TypedValue(0) {}
TXTtv.SetValue(New TypedValue(CInt(DxfCode.Start), "TEXT"), 0)
Dim TXTfilter As SelectionFilter = New SelectionFilter(TXTtv)
Dim TXTresult As PromptSelectionResult = ed.SelectAll(TXTfilter) '___________выбираются все тексты в чертеже
If TXTresult.Status = PromptStatus.OK Then
AllTXT = TXTresult.Value
ed.WriteMessage(vbCrLf & "В чертеже обнаружено " & AllTXT.Count.ToString & " текстов для обработки")
Else
ed.WriteMessage(vbCrLf & "В чертеже отсутствуют тексты" & vbCrLf)
Exit Sub
End If
'________________________________________________________________________
Dim DblResDopusk As PromptDoubleResult = ed.GetDouble(vbCrLf & "Введите допустимое расстояние от текста до 3-d точки")
If DblResDopusk.Status <> PromptStatus.OK Then
ed.WriteMessage(vbCrLf & "Необходимо ввести число" & vbCrLf)
Exit Sub
End If
Dim sInfo As String ' задаем переменную для информационной строки будущего файла
Dim PtName As String
Dim PtcoordX, PtcoordY, PtcoordH As Double
Dim TXTcoordX, TXTcoordY As Double
Dim sFile As String = doc.Name & "_пункты" & ".txt" 'считываем имя активного чертежа (отбрасываем расширение) - задаем полное имя файла
Dim writer As New System.IO.StreamWriter(sFile, False, Encoding.UTF8) 'создаем текстовый файл для записи в нём данных с кодировкой UTF8
Dim RowCounter As Integer = 0
'____________________________________________________________________________________________________________
For Each txtObj As SelectedObject In AllTXT 'перебираем каждый выбранный объект (текст)
Using Trans As Transaction = db.TransactionManager.StartTransaction() ' начинаем транзакцию
acBlkTbl = Trans.GetObject(db.BlockTableId, OpenMode.ForRead) 'открываем для чтения класс BlockTable
acBlkTblRec = Trans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Try 'начинаем обработку с блоком конструкцией улавливания ошибок
Dim ent As Entity = TryCast(Trans.GetObject(txtObj.ObjectId(), OpenMode.ForWrite), Entity) 'приводим выбранный объект к типу Entity
Dim MyTXT As DBText = TryCast(Trans.GetObject(ent.ObjectId, OpenMode.ForWrite), DBText) 'приводим выбранный объект от типа entity к нужному мне типу DBText
'_______________________ВОПРОС ПО ЭТОМУ БЛОКУ СТРОК - В РЕЗУЛЬТАТЕ ПЕРЕКОДИРОВКИ ПОЛУЧАЮТСЯ СТРОКИ, ГДЕ НЕКОТОРЫЕ ЗНАКИ КИРИЛЛИЦЫ ЗАМЕНЯЮТСЯ ЛАТИНИЦЕЙ
Dim mybuffer As Byte() = New Byte(255) {} '
mybuffer = Encoding.Unicode.GetBytes(MyTXT.TextString) '
mybuffer = Encoding.Convert(Encoding.Unicode, Encoding.UTF8, mybuffer) '
PtName = Encoding.UTF8.GetString(mybuffer) '
PtName = PtName.Normalize '
PtName = Trim(PtName) '
PtName = StrConv(PtName, vbProperCase) '
'_______________________________________________________________________________________________________
TXTcoordX = MyTXT.Position.X
TXTcoordY = MyTXT.Position.Y
For Each PtObj As SelectedObject In AllPT 'перебираем каждую выбранную точку
Dim PTent As Entity = TryCast(Trans.GetObject(PtObj.ObjectId(), OpenMode.ForWrite), Entity) 'приводим выбранный объект к типу Entity
'ed.WriteMessage(vbCrLf & "Тип выбранного объекта " & ent.GetType.ToString() & vbCrLf) ' вспомогательная строка для отладки
Dim MyPT As DBPoint = TryCast(Trans.GetObject(PTent.ObjectId, OpenMode.ForWrite), DBPoint) 'приводим выбранный объект от типа entity к нужному мне типу DBPoint
PtcoordX = Round(MyPT.Position.X, 3)
PtcoordY = Round(MyPT.Position.Y, 3)
PtcoordH = Round(MyPT.Position.Z, 3)
Dim MyRasst As Double = Vychisli_S(MyTXT.Position, MyPT.Position) 'вычисляется расстояние между точками во вспомогательной функции, и если оно меньше
' заданного допуска, то пишется строка с именем в виде содержимого текста и координатами точки
If MyRasst <= DblResDopusk.Value Then
'запускаем процедуру печатания строки текстового файла
sInfo = PtName & vbTab & PtcoordY.ToString & vbTab & PtcoordX.ToString & vbTab & PtcoordH.ToString & vbCrLf 'записываем данные в строчку через разделитель TAB
writer.Write(sInfo) 'записываем строку в файл
RowCounter += 1
End If
Next 'переходим к следующей точке
'____________________________________________________________________
Trans.Commit() 'закрываем транзакцию с примитивами
Catch ex As System.Exception 'в случае обнаружения ошибки пишем её описание и прерываем транзакцию
ed.WriteMessage("Ошибка " + ex.Message)
Trans.Abort()
Catch exA As Autodesk.AutoCAD.Runtime.Exception 'в случае обнаружения ошибки пишем её описание и прерываем транзакцию
ed.WriteMessage("Ошибка " + exA.Message)
Trans.Abort()
End Try
End Using
Next 'переходим к следующему выбранному тексту
writer.Close() 'закрываем запись файла
ed.WriteMessage(vbCrLf & "В файл записано " & RowCounter.ToString & " точек" & vbCrLf)
ed.WriteMessage(vbCrLf & "Создан файл " & sFile & vbCrLf) 'вспомогательно пишем в редактор сообщение о созданном файле, путь к файлу оттуда можно будет посмотреть
End Sub
