ADN Club > VBA

Блоки, вставка и Excel

<< < (3/3)

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)))и заработает

Навигация

[0] Главная страница сообщений

[*] Предыдущая страница

Перейти к полной версии