Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.DatabaseServices.LineWeight
Public Class acad_commands
' ТЕСТОВАЯ КОМАНДА ГЕНЕРАЦИИ ФАЙЛА
<CommandMethod("TEST_T")> _
Public Sub Add_DWG_FILE()
' 0. ПРОВЕРКА НАЛИЧИЯ ФАЙЛА ШАБЛОНА
Dim NameTemplate As String = "C:\2\mytempl.dwt" ' мой шаблон
Dim fsn = New FileIO.FileSystem
If Not fsn.FileExists(NameTemplate) Then
MsgBox("Файл шаблона " & NameTemplate & " не найден.")
Exit Sub
End If
Dim db As New Database(false, true) ' 2014.10.23 добавил аргументы
' 1. ЧИТАЕМ БАЗУ ДАННЫХ ИЗ ШАБЛОНА DWT
Try
db.ReadDwgFile(NameTemplate, IO.FileShare.ReadWrite, False, Nothing)
Catch ex As System.Exception
MsgBox("Файл шаблона " & NameTemplate & vbCrLf & "создан в более новой версии AutoCAD" & vbCrLf & _
ex.Message)
db.Dispose()
Exit Sub
End Try
' 2. ДОБАВЛЯЕМ КОЛЕЕКЦИЮ ents ПРИМИТИВОВ В БАЗУ ТЕКСТОМ
Dim ents = New List(Of Entity)
Dim tCnt As Integer = 1 ' кол-во добавляемых текстов
For i As Integer = 0 To tCnt - 1
Dim newTxt As DBText = acadnet_Create_DBText(New pnt2d(10 * i, 10 + i), "строка", 1, 0)
ents.Add(newTxt)
Next
' 3. ДОБАВЛЕНИЕ ПРИМИТИВОВ В БАЗУ ДАННЫХ ЧЕРТЕЖА
Append_images(ents, db)
db.CloseInput(True) ' 2014.10.23 ' Переставил эту строчку сюда, т.к ей не место после Finally оператора try
' 4. СОЗДАЕМ НОВЫЙ ФАЙЛ С ЗАПОЛНЕННОЙ БАЗОЙ ДАННЫХ
Try
Dim FullFileName As String = "C:\2\mynewfile.dwg"
db.SaveAs(FullFileName, Autodesk.AutoCAD.DatabaseServices.DwgVersion.AC1015) ' соотв. формату acad 2004
If fsn.FileExists(FullFileName) Then
MsgBox("Создан файл " & FullFileName)
End If
Catch ex As System.Exception
MsgBox("Ошибка записи в файл " & vbCrLf & ex.Message)
Finally
' 5. ЗАВЕРШАЮЩИЕ ПРОЦЕДУРЫ
db.Dispose()
End Try
End Sub
' Добавление примитивов ents в базу данных db
Public Shared Sub Append_images(ByVal ents As List(Of Entity), _
ByVal db As Database)
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForWrite)
Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
For i As Integer = 0 To ents.Count - 1
Try
' добавляем примитив
Dim id = btr.AppendEntity(ents.Item(i))
tr.AddNewlyCreatedDBObject(ents.Item(i), True)
' выравниванием примитив, если текст
acadnet_primitive_SetAlignText_ByEnt(ents.Item(i), _
TextHorizontalMode.TextCenter, _
TextVerticalMode.TextVerticalMid)
Catch ex As System.Exception
End Try
Next
tr.Commit()
tr.Dispose()
End Using
End Sub
' выравнивание текста Ent
Public Shared Sub acadnet_primitive_SetAlignText_ByEnt(ByRef Ent As Entity, _
ByVal horMode As TextHorizontalMode, _
ByVal vertMode As TextVerticalMode)
If Not TypeOf Ent Is DBText Then Exit Sub
Ent.UpgradeOpen()
With DirectCast(Ent, DBText)
.HorizontalMode = horMode
.VerticalMode = vertMode
.AlignmentPoint = .Position
End With
End Sub
' создает пимитив DBText
Public Shared Function acadnet_Create_DBText(ByVal pos As pnt2d, _
ByVal s As String, _
ByVal H As Double, _
ByVal rot As Double) As DBText
Dim txt = New DBText
txt.TextString = s
txt.Height = H
txt.WidthFactor = 1
txt.Rotation = rot
txt.Position = New Autodesk.AutoCAD.Geometry.Point3d(pos.x, pos.y, 0)
Return txt
End Function
Public Class pnt2d
Public x As Double
Public y As Double
Public Sub New(ByVal _x As Double, ByVal _y As Double)
Me.x = _x
Me.y = _y
End Sub
End Class
End Class
