ADN Club > VBA
Видеоуроки AutoCAD VBA
Максим Маркевич:
5. Изменение динамических свойств блока
В данном видео объясняется, как программно вставить в чертеж AutoCAD динамический блок с измененными свойствами.
--- Код - Visual Basic [Выбрать] ---Sub InsertBlock() Dim blockRef As AcadBlockReference Dim name As String Dim pp As Variant 'В случае ошибки переходим к следующему действию On Error Resume Next 'Получаем точку вставки блока pp = ThisDrawing.Utility.GetPoint(, "Укажите точку вставки блока:") 'Имя блока name = "Тестовый" 'Вставка блока Set blockRef = ThisDrawing.ModelSpace.InsertBlock(pp, name, 1, 1, 1, 0) 'Получение динамических свойств блока If blockRef.IsDynamicBlock = True Then Props = blockRef.GetDynamicBlockProperties For Index = LBound(Props) To UBound(Props) Set prop = Props(Index) If prop.PropertyName = "Длина" Then prop.Value = 40# ElseIf prop.PropertyName = "Ширина" Then prop.Value = 33# End If Next End IfEnd Sub
Максим Маркевич:
6 Изменение атрибутов блока
В данном видео объясняется, как программно вставить в чертеж AutoCAD динамический блок с измененным атрибутом, то есть с измененной текстовой строкой атрибута.
--- Код - Visual Basic [Выбрать] ---Sub InsertBlock() Dim blockRef As AcadBlockReference Dim name As String Dim pp As Variant 'В случае ошибки переходим к следующему действию On Error Resume Next 'Получаем точку вставки блока pp = ThisDrawing.Utility.GetPoint(, "Укажите точку вставки блока:") 'Имя блока name = "Тестовый" 'Вставка блока Set blockRef = ThisDrawing.ModelSpace.InsertBlock(pp, name, 1, 1, 1, 0) 'Получение динамических свойств блока If blockRef.IsDynamicBlock = True Then Props = blockRef.GetDynamicBlockProperties For Index = LBound(Props) To UBound(Props) Set prop = Props(Index) If prop.PropertyName = "Длина" Then prop.Value = 40# ElseIf prop.PropertyName = "Ширина" Then prop.Value = 33# End If Next End If 'Получение атрибутов If blockRef.HasAttributes = True Then att = blockRef.GetAttributes For i = LBound(att) To UBound(att) If att(i).TagString = "АТРИБУТ" Then att(i).TextString = "Кекс" End If Next End IfEnd Sub
Максим Маркевич:
7 Связка AutoCAD и Excel через блок
Видеоурок, в котором подводится итог по связке AutoCAD и Excel.
--- Код - Visual Basic [Выбрать] ---Sub InsertBlock() Dim blockRef As AcadBlockReference Dim name As String Dim pp As Variant Dim AP As Excel.Application Dim WB As Excel.Workbook Dim WS As Excel.Worksheet 'В случае ошибки переходим к следующему действию On Error Resume Next 'Подключаемся к Excel Set AP = Excel.Application Set WB = AP.Workbooks.Open("m:\Excel.xlsx") Set WS = WB.Worksheets("Лист1") 'Получаем точку вставки блока pp = ThisDrawing.Utility.GetPoint(, "Укажите точку вставки блока:") 'Имя блока name = "Тестовый" 'Вставка блока Set blockRef = ThisDrawing.ModelSpace.InsertBlock(pp, name, 1, 1, 1, 0) 'Получение динамических свойств блока If blockRef.IsDynamicBlock = True Then Props = blockRef.GetDynamicBlockProperties For Index = LBound(Props) To UBound(Props) Set prop = Props(Index) If prop.PropertyName = "Длина" Then prop.Value = Cells(1, 2) * 1 ElseIf prop.PropertyName = "Ширина" Then prop.Value = Cells(2, 2) * 1 End If Next End If 'Получение атрибутов If blockRef.HasAttributes = True Then att = blockRef.GetAttributes For i = LBound(att) To UBound(att) If att(i).TagString = "АТРИБУТ" Then att(i).TextString = Cells(3, 2) End If Next End IfEnd Sub
Александр Ривилис:
--- Цитата: Максим Маркевич от 18-08-2016, 00:24:05 ---
--- Код - Visual Basic [Выбрать] ---prop.Value = Cells(1, 2) * 1
--- Конец цитаты ---
А зачем здесь умножение на единицу?
Максим Маркевич:
--- Цитата: Александр Ривилис от 18-08-2016, 01:23:36 ---А зачем здесь умножение на единицу?
--- Конец цитаты ---
Потому что Cells(1, 2) получено из Excel - это строка. А prop.Value не присвоишь строку в VBA.
Можно было бы сделать так:
--- Код - Visual Basic [Выбрать] ---prop.Value = CDbl(Cells(1, 2))или вот так:
--- Код - Visual Basic [Выбрать] ---Dim buf As Doublebuf = Cells(1, 2)prop.Value = bufИли схитрить с умножением на единицу, как сделано в моем примере.
Навигация
Перейти к полной версии