Обсуждение видеоуроков AutoCAD VBA

Автор Тема: Обсуждение видеоуроков AutoCAD VBA  (Прочитано 75338 раз)

0 Пользователей и 2 Гостей просматривают эту тему.

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 46
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #195 : 19-01-2021, 11:13:52 »
Во вложении файл
Не получается задать параметр длина в цикле

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 23
  • Карма: 1
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #196 : 19-01-2021, 11:26:45 »
ох-хо-хох..

Попытайтесь приучить себя писать код без директивы On error resume next.
Когда Вы ее прописываете то отключаются все уведомления об ошибках, а у Вас их там порядочно.

а что собственно, Вы пытаетесь сделать? не легче приучить себя работать в лисах и этих проблем с расстановкой форматок в принципе не будет

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 46
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #197 : 19-01-2021, 11:30:56 »
В листах было бы вообще замечательно если бы я смог програмно их создать и настроить под печать. Пока много одинаковых шаблонных файлов планируется создавать и хочу от проблемы распечатки уйти настроив сразу расстановку
и из эксель мне это проще делать меняя атрибуты
'On Error Resume Next - закомментировал- код отработал но Длина не берется

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 23
  • Карма: 1
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #198 : 19-01-2021, 11:33:35 »
"если бы я смог програмно их создать и настроить под печать." - сможете! Идите почитайте те ссылки что я кидал, там ведь есть примеры кода, потом открываете объектную модель и ищете объект лист, читаете какие у него метода и свойства

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 46
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #199 : 19-01-2021, 11:36:28 »
я читаю и смотрю видео - пока все туго идет, но я стараюсь и ошибку хотелось бы устранить в этой идее расстановки форматок в модели

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 23
  • Карма: 1
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #200 : 19-01-2021, 11:58:54 »
В листах было бы вообще замечательно если бы я смог програмно их создать и настроить под печать. Пока много одинаковых шаблонных файлов планируется создавать и хочу от проблемы распечатки уйти настроив сразу расстановку
и из эксель мне это проще делать меняя атрибуты
'On Error Resume Next - закомментировал- код отработал но Длина не берется

Вот прям отработал? и без одной ошибки?
и где отступы?? расставлены для галочки

Код - Visual Basic [Выбрать]
  1. Option Explicit
  2. Private Type ScaleFactor
  3.     X As Double
  4.     Y As Double
  5.     Z As Double
  6. End Type
  7. Sub InsertBlocks()
  8.     Dim acadApp                 As Object
  9.     Dim height                  As Double
  10.     Dim acadDoc                 As Object
  11.     Dim acadBlock               As Object
  12.     Dim attributeObj            As Object
  13.     Dim LastRow                 As Long
  14.     Dim i                       As Long
  15.     Dim InsertionPoint(0 To 2)  As Double
  16.     Dim BlockName               As String
  17.     Dim BlockScale              As ScaleFactor
  18.     Dim RotationAngle           As Double
  19.     Dim tag                     As String
  20.     Dim value                   As String
  21.     Dim prompt                  As String
  22.     Dim varAttributes As Variant
  23.     Dim varBlockProperties As Variant
  24.     Dim Index As Variant
  25.     Dim prop As Variant
  26.     Dim propatr As Variant
  27.    'Activate the coordinates sheet and find the last row.
  28.    With Sheets("Coordinates")
  29.         .Activate
  30.         LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  31.     End With
  32.        
  33.     'Check if there are coordinates for at least one circle.
  34.    If LastRow < 2 Then
  35.         MsgBox "There are no coordinates for the insertion point!", vbCritical, "Insertion Point Error"
  36.         Exit Sub
  37.     End If
  38.     'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
  39.    On Error Resume Next
  40.     Set acadApp = GetObject(, "AutoCAD.Application")
  41.     If acadApp Is Nothing Then
  42.         Set acadApp = CreateObject("AutoCAD.Application")
  43.         acadApp.Visible = True
  44.     End If
  45.     'Check (again) if there is an AutoCAD object.
  46.    If acadApp Is Nothing Then
  47.         MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
  48.         Exit Sub
  49.     End If
  50.     On Error GoTo 0
  51.     'If there is no active drawing create a new one.
  52.    On Error Resume Next
  53.     Set acadDoc = acadApp.ActiveDocument
  54.     If acadDoc Is Nothing Then
  55.         Set acadDoc = acadApp.Documents.Add
  56.     End If
  57.     On Error GoTo 0
  58.     'Check if the active space is paper space and change it to model space.
  59.    If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  60.        acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  61.    End If
  62.  
  63.  
  64.     'On Error Resume Next ' --  здесь комментируем
  65.  
  66.  
  67.     'Loop through all the rows and add the corresponding blocks in AutoCAD.
  68.    With Sheets("Coordinates")
  69.         For i = 2 To LastRow
  70.             'Задаем имя блока
  71.            BlockName = .Range("A" & i).value
  72.             'Вставляем блок если он есть
  73.            If BlockName <> vbNullString Then
  74.                 'Задаем координаты вставки блока
  75.                InsertionPoint(0) = .Range("B" & i).value
  76.                 InsertionPoint(1) = .Range("C" & i).value
  77.                 InsertionPoint(2) = .Range("D" & i).value
  78.                 'Задаем геометрию блока
  79.                BlockScale.X = .Range("E" & i).value
  80.                 BlockScale.Y = .Range("F" & i).value
  81.                 BlockScale.Z = .Range("G" & i).value
  82.                 'Задаем Поворот блока
  83.                RotationAngle = 0
  84.                 Set attributeObj = acadBlock.AddAttribute(height, prompt, InsertionPoint, tag, value) ' ошибка №1
  85.                Set acadBlock = acadDoc.ModelSpace.InsertBlock(InsertionPoint, BlockName, BlockScale.X, BlockScale.Y, BlockScale.Z, RotationAngle * 0.0174532925)
  86.             End If
  87.                 varAttributes = acadBlock.GetAttributes
  88.                 varAttributes(0).TextString = .Range("L" & i).value
  89.                 varAttributes(1).TextString = .Range("M" & i).value
  90.                 varAttributes(2).TextString = .Range("N" & i).value    ' ошибка №2
  91.                varAttributes(3).TextString = .Range("O" & i).value    ' ошибка №3
  92.                varAttributes(4).TextString = .Range("P" & i).value    ' ошибка №4
  93.                varAttributes(5).TextString = .Range("Q" & i).value    ' ошибка №5
  94.                'varAttributes(6).TextString = .Range("L" & i).value
  95.                'varAttributes(7).TextString = .Range("M" & i).value
  96.                acadBlock.Layer = .Range("K" & i).value    
  97.                 If acadBlock.IsDynamicBlock = True Then
  98.                 varBlockProperties = acadBlock.GetDynamicBlockProperties
  99.                 For Index = LBound(varBlockProperties) To UBound(varBlockProperties)
  100.                 Set prop = varBlockProperties(Index)
  101.                 If prop = prop.PropertyName = "Ширина" Then    ' ошибка №6
  102.                    prop.value = .Range("H" & i).value
  103.                 ElseIf prop = prop.PropertyName = "Длина" Then    ' ошибка №7
  104.                    prop.value = .Range("Длина" & i).value
  105.                 End If
  106.                 acadBlock.Layer = .Range("K" & i).value    ' это нафига в цикле, плюс это дубль
  107.                Next
  108.                 End If
  109.                 'varBlockProperties.Update
  110.        Next i
  111.     End With
  112.     'Zoom in to the drawing area.
  113.    acadApp.ZoomExtents
  114.     'Release the objects.
  115.    Set acadBlock = Nothing
  116.     Set acadDoc = Nothing
  117.     Set acadApp = Nothing
  118. End Sub
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 46
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #201 : 19-01-2021, 13:05:12 »
Подскажите если у дин блока имена .PropertyName - называются для обращения, то как обратится к атрибуту? какая там фраза?

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 12440
  • Карма: 1614
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #202 : 19-01-2021, 13:10:09 »
Подскажите если у дин блока имена .PropertyName - называются для обращения, то как обратится к атрибуту? какая там фраза?
Эту фразу я не понял, но ты наверное говоришь про .TagString
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 46
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #203 : 19-01-2021, 13:17:14 »
спасибо да о ней
Работа над ошибками: прокомментировал как понимаю, поправил вроде все какие замечания дали. Поглядите все ли норм
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2. Private Type ScaleFactor
  3.     X As Double 'Объявляем переменные
  4.    Y As Double
  5.     Z As Double
  6. End Type
  7. Sub InsertBlocks()
  8.     Dim acadApp                 As Object 'Объявляем переменные
  9.    Dim height                  As Double
  10.     Dim acadDoc                 As Object
  11.     Dim acadBlock               As Object
  12.     Dim attributeObj            As Object
  13.     Dim LastRow                 As Long
  14.     Dim i                       As Long
  15.     Dim InsertionPoint(0 To 2)  As Double
  16.     Dim BlockName               As String
  17.     Dim BlockScale              As ScaleFactor
  18.     Dim RotationAngle           As Double
  19.     Dim tag                     As String
  20.     Dim value                   As String
  21.     Dim prompt                  As String
  22.     Dim varAttributes As Variant
  23.     Dim varBlockProperties As Variant
  24.     Dim Index As Variant
  25.     Dim prop As Variant
  26.     Dim propatr As Variant
  27.    
  28.     With Sheets("Coordinates") 'Делаем активным лист координаты
  29.        .Activate
  30.         LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ищем последнюю заполненную строку столбца A
  31.    End With
  32.     If LastRow < 2 Then 'Если номер последней строки меньше чем два
  33.        MsgBox "Нет ни одной координаты для вставки блока", vbCritical, "Ошибка координат вставки блока"
  34.         Exit Sub
  35.     End If
  36.     On Error Resume Next
  37.    
  38.     Set acadApp = GetObject(, "AutoCAD.Application") 'Проверяем открыт ли автокад
  39.    If acadApp Is Nothing Then 'Если автокад не открыт
  40.        Set acadApp = CreateObject("AutoCAD.Application") 'Создаем новую сессию автокад
  41.        acadApp.Visible = True 'Делаем автокад видимым
  42.    End If
  43.     If acadApp Is Nothing Then 'Если опять автокад не открыт
  44.        MsgBox "Извините, но мы не можем запустить автокад", vbCritical, "Ошибка запуска автокад"
  45.         Exit Sub
  46.     End If
  47.     On Error GoTo 0 'Если ошибка то идем хз куда
  48.    On Error Resume Next 'Если ошибка то идем дальше
  49.    
  50.     Set acadDoc = acadApp.ActiveDocument 'Присваиваем переменную активному чертежу автокада
  51.    If acadDoc Is Nothing Then 'Если ни один чертеж автокада не активен
  52.        Set acadDoc = acadApp.Documents.Add 'Создаем новый чертеж
  53.    End If
  54.     On Error GoTo 0 'Если ошибка то идем хз куда
  55.    If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding. Если чертеж открыт не в модели, а в листах
  56.        acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding. Делаем активной модель
  57.    End If
  58.    
  59.     With Sheets("Coordinates") 'С листом Coordinates Excel
  60.        For i = 2 To LastRow 'Цикл начиная со второй строки до последней заполненной в столбце А
  61.            BlockName = .Range("A" & i).value 'Присваиваем переменную имя блока по значению из ячейки А листа эксель
  62.            'Вставляем блок если он есть
  63.            If BlockName <> vbNullString Then 'Если данный блок присутствует в чертеже автокад
  64.            
  65.                 InsertionPoint(0) = .Range("B" & i).value 'Задаем координату X вставки блока
  66.                InsertionPoint(1) = .Range("C" & i).value 'Задаем координату Y вставки блока
  67.                InsertionPoint(2) = .Range("D" & i).value 'Задаем координату Z вставки блока
  68.                
  69.                 BlockScale.X = .Range("E" & i).value 'Задаем масштаб по X вставки блока
  70.                BlockScale.Y = .Range("F" & i).value 'Задаем масштаб по Y вставки блока
  71.                BlockScale.Z = .Range("G" & i).value 'Задаем масштаб по Z вставки блока
  72.                
  73.                 RotationAngle = 0 'Задаем угол поворота блока равным нулю
  74.                
  75.                 Set acadBlock = acadDoc.ModelSpace.InsertBlock(InsertionPoint, BlockName, BlockScale.X, BlockScale.Y, BlockScale.Z, RotationAngle * 0.0174532925) 'Вставляем блок в чертеж
  76.                acadBlock.Layer = .Range("K" & i).value  'Устанавливаем нулевой слой для блока
  77.            End If
  78.                
  79.             varAttributes = acadBlock.GetAttributes 'Получаем атрибуты блока
  80.                For Each propatr In varAttributes 'Циклом проходим по всем атрибутам
  81.                    Select Case propatr.TagString 'Открываем портфель атрибутов
  82.                        Case "КАНОН-ФОРМАТ"
  83.                             propatr.TagString = .Range("L" & i).value 'Задаем значение атрибута 1
  84.                        Case "ОРИЕНТАЦИЯ"
  85.                             propatr.TagString = .Range("M" & i).value 'Задаем значение атрибута 2
  86.                    End Select 'Завершаем выбор
  87.                Next
  88.    
  89.                 If acadBlock.IsDynamicBlock = True Then 'Если блок динамический (обязательно ли это?)
  90.                    varBlockProperties = acadBlock.GetDynamicBlockProperties 'Получаем свойства дин блока
  91.                    For Each prop In varBlockProperties 'Циклом проходим по всем свойствам
  92.                        Select Case prop.PropertyName 'Открываем портфель свойств
  93.                            Case "Длина"
  94.                                 prop.value = .Range("I" & i).value * 1 'Задаем свойство 1
  95.                            Case "Ширина"
  96.                                 prop.value = .Range("H" & i).value * 1 'Задаем свойство 2
  97.                        End Select 'Завершаем выбор
  98.                    Next
  99.                 End If
  100.         Next i ' Переход к следующей строке эксель
  101.    End With ' Завершение взятия данных с листа эксель
  102.    acadApp.ZoomExtents ' Двойное нажатие на колесико мыши
  103.    Set acadBlock = Nothing ' ХЗ зачем обнуляем наверное перменные
  104.    Set acadDoc = Nothing ' ХЗ зачем обнуляем наверное перменные
  105.    Set acadApp = Nothing ' ХЗ зачем обнуляем наверное перменные
  106. End Sub