ADN Club > VBA
Блоки, вставка и Excel
TiDi:
Ну если вы собрались это делать вручную...
Я же вам написал алгоритм, который нужно осуществить.
Он довольно просто трансформируется в VBA код.
Smiti:
--- Цитата: TiDi от 19-12-2022, 16:15:23 ---Я же вам написал алгоритм, который нужно осуществить.
--- Конец цитаты ---
возможно я не понял алгоритм.
сейчас я вручную делаю дхф и хочу этот процесс автоматизировать. есть понимание что за чем должно быть, но не могу это выразить в коде.
TiDi:
Скопируйте код в excel, где лежит ваша спецификация и откройте чертеж, где есть определение блока
Не забудьте добавить ссылку на библиотеку AutoCAD
--- Код - Visual Basic [Выбрать] ---Sub new_dxf() Dim blockRef As AcadBlockReference Dim blockname As String Dim props As Variant Dim Index, i As Variant Dim prop As Variant Dim Path As String Dim CellValue As String Dim FinalFileName As String Dim basePnt(0 To 2) As Double Dim x, y, z As Variant On Error Resume Next Set AC = AutoCAD.Application.ActiveDocument Set WS = ThisWorkbook.ActiveSheet lastrow = ActiveSheet.Cells(1, 1).End(xlDown).Rows + 1 For i = 2 To lastrow 'укажите название вашего блока blockname = "1" x = 0: y = 0: z = 0 basePnt(0) = x: basePnt(1) = y: basePnt(2) = z Set blockRef = AC.ModelSpace.InsertBlock(basePnt, blockname, 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(i, 2) * 1 ElseIf prop.PropertyName = "Ширина" Then prop.Value = Cells(i, 3) * 1 End If Next End If 'укажите свой путь Path = "C:\Users\user\Desktop\" CellValue = Cells(i, 1) FinalFileName = Path & CellValue AC.SaveAs FinalFileName, ac2007_dxf Set objss = AC.SelectionSets.Add("ToErase") objss.Select acSelectionSetAll objss.Erase objss.Delete Next i End Sub
Smiti:
--- Цитата: TiDi от 19-12-2022, 19:30:19 ---Скопируйте код в excel, где лежит ваша спецификация и откройте чертеж, где есть определение блока
Не забудьте добавить ссылку на библиотеку AutoCAD
--- Конец цитаты ---
Благодарю. после некоторых манипуляций этот код у меня заработал. но возник вопрос: как прописать переменную для названия файла так чтобы скрипт работал не только с цифровыми значениями но и с буквенными. Если в первом столбце стоят цифры, то все работает. а если ставлю буквы, то ноль реакции.
TiDi:
Вот эту строчку
--- Код - Visual Basic [Выбрать] ---lastrow = ActiveSheet.Cells(1, 1).End(xlDown).Rows + 1замените на эту:
--- Код - Visual Basic [Выбрать] ---lastrow = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))и заработает
Навигация
Перейти к полной версии