10.5. Добавление текста

Для вставки текста в чертеж можно использовать следующую программу.

Пользователя просят ввести сам текст, точку вставки и угол разворота.

Пример 9.

Sub Text()

Dim objText As AcadText

Dim Text As String

Dim Angl As ACAD_ANGLE

Dim Coord As Variant

Do

On Error GoTo Line:

Text = ThisDrawing.Utility.GetString(True, «Введите однострочный текст:»)

Coord = ThisDrawing.Utility.GetPoint(, «Введите точку вставки:»)

Angl = ThisDrawing.Utility.GetAngle(, «Введите угол:»)

Set objText = ThisDrawing.ModelSpace.AddText(Text, Coord, 40)

`величина 40 это высота текста

objText.Rotate Coord, Ahgl

Loop

Line:

End Sub

10.6. Запись координат точек в таблицу ms Excel

Перед использованием этой процедуры сначала надо в проекте создать ссылку на библиотеку функций MS Excel – Microsoft Excel 9.0 Object Library (файл Excel9.olb).

Для этого нужно выбрать пункт меню «Tools → Referencer» в редакторе VBA от AutoCAD.

Пример 10.

Const str = “C:\Programm files\”

Sub ImportPoint()

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim coord As ACAD_POINT

Dim objEnt As AcadEntity

Dim intCrdCnt As Integer

Dim dir As String

Set xlApp As Excel.Application

Dim xlBook As Excel.Workbook.Add

Dim xlSheet As Excel.Worksheet.Add

intCrdCnt = 0

dir = ThisDrawing.Utility.GetString(1, «Введите имя файла:»)

x1Book.SaveAs str & dir & “.xls”

Do

On Error GoTo Line

Coord = ThisDrawing.Utility.GetString(, «Укажите точку:»)

Cells(intCrdCnt + 1, 1).Valua = coord(0)

Cells(intCrdCnt + 1, 2).Valua = coord(1)

intCrdCnt = intCrdCnt + 1

Loop

Line:

X1Book.Save

X1Book.Close

X1App.Quit

Set x1Sheet = Nothing

Set x1Book = Nothing

Set x1App = Nothing

End Sub

Программа просит пользователя указать мышью на экране точки, координаты которых необходимо записать в таблицу MS Excel. Создается файл с расширением .xls который находится в каталоге “C:\Program files\”.

10.7. Чтение координат точек из таблицы ms Excel

Пример 11.

Аналогично предыдущей программе необходимо создать ссылку на библиотеку объектов MS Excel.

Const str = “C:\Programm files\”

Sub ImportPoint()

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim point1 As ACAD_POINT

Dim coord1 (2) As Double

Dim objEnt As AcadEntity

Dim intCrdCnt As Integer

Dim RowCount As Integer

Dim dir As String

Dim vertList() As Double

Set xlApp As Excel.Application

dir = ThisDrawing.Utility.GetString(1, «Введите имя файла:»)

Set x1Book.= x1App.Workbook.Open (str & dir & “.xls”)

Set x1Sheet = x1Book.Sheets(1)

RowCount = x1Sheet.UsedRange.Rows.Count

ReDim veryList((RowCount * 2) – 1)

RowCount = 1

For intCrdCnt = LBound(vertList) To UBound(vertList) Step 2

Coord1(0) = xlSheet.Cells(RowCount, 1). Value

Coord1(1) = xlSheet.Cells(RowCount, 2). Value

On Error GoTo Line

Set point1 = ThisDrawing.ModelSpace.AddPoint(coord1)

RowCount = RowCount + 1

Next

Line:

X1Book.Close

X1App.Quit

Set x1Sheet = Nothing

Set x1Book = Nothing

Set x1App = Nothing

End Sub

Программа запрашивает входной файл с расширением .xls. Необходимо чтобы координаты точек располагались в первых двух столбцах таблицы.