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

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

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

Оффлайн FocusNIK

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #120 : 26-04-2017, 20:47:10 »
Насколько я понял из этого : http://vbamodel.narod.ru/AutoCAD/idh_insertionpoint.htm
object.InsertionPoint применяется для:  Attribute, AttributeReference, BlockRef, ExternalReference, MInsertBlock, MText, Shape, Text, Tolerance Symbol

У меня не получилось это побороть. Был бы признателен, если приложили пример использования с атрибутами блока. Применил бы в своей практике.
А еще бы не отказался от книги по данному направлению... А то после VBA для Excel был крайне дезориентирован структурированием построения кода.
PS. Я по профессии инженер по вентиляции. Поэтому изучаю по мере возможности и прошу не ругать за глупые вопросы.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #121 : 26-04-2017, 23:33:32 »
Судя по тому, что я вижу, InsertionPoint есть как для многострочных, так и для однострочных атрибутов (равно как и TextAlignmentPoint).

Кстати, что GetAttributes, что GetConstantAttributes возвращают массив указателей на обычные атрибуты и постоянные атрибуты. Разницы в этом между ними никакой. Для примера (заранее прошу прощения за качество кода - на VBA уже очень давно ничего не писал):
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. Public Sub test()
  4. Dim ent As AcadEntity, blkRef As AcadBlockReference
  5. Dim pt As Variant, arAttr As Variant, arConstAttr As Variant
  6.   ThisDrawing.Utility.GetEntity ent, pt
  7.   If ent.ObjectName = "AcDbBlockReference" Then
  8.     Set blkRef = ent
  9.     arAttr = blkRef.GetAttributes
  10.     arConstAttr = blkRef.GetConstantAttributes
  11.   End If
  12. End Sub
Пошаговая отладка многое покажет :)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Владимир П

  • ADN OPEN
  • **
  • Сообщений: 57
  • Карма: 3
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #122 : 27-04-2017, 07:47:43 »
если приложили пример использования с атрибутами блока
Ну, вот если из моего примера, то вот так заработало
Код - Visual Basic [Выбрать]
  1. '    Dim att As Variant
  2.    Dim att As AcadAttributeReference
  3.     Dim LB(0 To 2) As Double
  4.     Dim blokObj As AcadBlockReference
  5.     Set blokObj = elem
  6.     Dim varAttributes As Variant
  7.     ' Получение атрибутов
  8.    If blokObj.HasAttributes = True Then
  9.         varAttributes = blokObj.GetAttributes
  10. '        varAttributes = blokObj.GetConstantAttributes
  11.        For i = LBound(varAttributes) To UBound(varAttributes)
  12.             Set att = varAttributes(i)
  13.             If att.TagString = "ШИФР" Then
  14.                  LB(0) = att.InsertionPoint(0)
  15.                 MsgBox (LB(0))
  16.             End If
  17.         Next
  18.     End If
  19.  
Но! в вашем изначальном блоке я исправил с свойствах атрибута постоянный на "НЕТ".
Вам конечно виднее, но уверен, что постоянный не нужен. Сам решал эту задачку со штампом давненько и как-то обошелся без GetConstantAttributes.
Больше того, если тупо заменить
       
Код - Visual Basic [Выбрать]
  1. varAttributes = blokObj.GetAttributes
на
'       
Код - Visual Basic [Выбрать]
  1. varAttributes = blokObj.GetConstantAttributes
возникнет ошибка связанная с тем, что все-таки Attribute и AttributeReference - разные вещи.
Можно конечно переделать все объявления правильно и наверное заработает и с GetConstantAttributes, но... зачем?


« Последнее редактирование: 27-04-2017, 21:02:16 от Александр Ривилис »

Оффлайн wavaw

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #123 : 10-05-2017, 18:17:33 »
здравствуйте.
код со второго урока ошибку выдаёт :"user-defined type not defined"
сам код -

   
Код - Visual Basic [Выбрать]
  1.  Dim AP As Excel.Application
  2.     Dim WB As Excel.Workbook
  3.     Dim WS As Excel.Worksheet
  4.     Dim pp As Variant
с первой же строчки ошибка

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

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #124 : 10-05-2017, 18:46:31 »
wavaw
Библиотека Microsoft Excel подключена?



Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн wavaw

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #125 : 21-05-2017, 11:16:52 »
да, действительно галочка "слетела".

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #126 : 28-05-2017, 21:03:32 »
Здравствуйте! Спасибо Вам за прекрасный макрос печати. Использую код из 14 урока. Поменял принтер на PDFCreator. Появилась проблема, он не печатает А0, А1, А2 и не стандартные форматы (типа А4х3), с др. форматами нормально.

Извините, вам запрещён просмотр содержимого спойлеров.


Что нужно изменить? Спасибо

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

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #127 : 28-05-2017, 21:27:34 »
Что нужно изменить? Спасибо
Изменить нужно видимо строку:
Код - Visual Basic [Выбрать]
  1. Layout.CanonicalMediaName = "A1"
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #128 : 28-05-2017, 21:57:27 »
Изменить нужно видимо строку:
VBA я толком незнаю, а на что конкретней нужно поменять? Спасибо

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

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #129 : 28-05-2017, 21:59:43 »
VBA я толком незнаю, а на что конкретней нужно поменять? Спасибо
Тут не вопрос знания VBA, а вопрос знания того, какое каноническое имя для PDFCreator для локального имени "A1". Вот на это имя и нужно поменять.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #130 : 28-05-2017, 22:07:24 »
Тут не вопрос знания VBA, а вопрос знания того, какое каноническое имя для PDFCreator для локального имени "A1". Вот на это имя и нужно поменять.
Спасибо, буду разбираться

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

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #131 : 28-05-2017, 22:17:56 »
Обрати внимание на эту картинку:



Возможно еще зависит и от версии PDFCreator и/или версии AutoCAD.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

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

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #132 : 28-05-2017, 23:04:09 »
Я немного поигрался и сделал такой код:
Код - Visual Basic [Выбрать]
  1. '1. Печать в пдф при помощи выбора нижней левой и верхней правой точек
  2. Sub PlotByPoints()
  3.     ' Декларируем
  4.    Dim Layout As AcadLayout
  5.     Dim pt1 As Variant, pt2 As Variant
  6.    
  7.     ' Устанавливаем
  8.    Set Layout = ThisDrawing.ActiveLayout
  9.    
  10.     ' Получаем первую точку рамки
  11.    pt1 = ThisDrawing.Utility.GetPoint(, "Выберите нижний левый угол")
  12.     ' Переводим координаты из WCS в DCS
  13.    pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  14.     ReDim Preserve pt1(0 To 1)   ' Приводим массив к 2д виду, удаляем z координату
  15.    
  16.     ' Получаем вторую точку
  17.    pt2 = ThisDrawing.Utility.GetPoint(, "Выберите правый верхний угол")
  18.     ' Переводим координаты из WCS в DCS
  19.    pt2 = ThisDrawing.Utility.TranslateCoordinates(pt2, acWorld, acDisplayDCS, False)
  20.     ReDim Preserve pt2(0 To 1)   ' Приводим массив к 2д виду, удаляем z координату
  21.        
  22.     ' Настройка печати
  23.    Layout.ConfigName = "PDFCreator"
  24.    
  25.     ' Обновим текущую плот-информацию
  26.    Layout.RefreshPlotDeviceInfo
  27.    
  28.     ' Печатаем на формат A0
  29.    Layout.CanonicalMediaName = GetCanonicalFromLocalName(Layout, "A0")
  30.    
  31.     Layout.CenterPlot = True
  32.     Layout.PlotRotation = ac90degrees
  33.     Layout.StandardScale = acScaleToFit
  34.     Layout.StyleSheet = "acad.ctb"
  35.    
  36.     ' Устанавливаем рамки окошка
  37.    Layout.SetWindowToPlot pt1, pt2
  38.     Layout.PlotType = acWindow
  39.    
  40.     ' Отправляем на печать
  41.    ThisDrawing.Regen acAllViewports
  42.     ThisDrawing.Plot.PlotToDevice
  43.    
  44. End Sub
  45. ' Функция преобразует из локального имени в каноническое
  46. Function GetCanonicalFromLocalName(Layout As AcadLayout, lName As String) As String
  47.     Dim cNames As Variant
  48.     cNames = Layout.GetCanonicalMediaNames()
  49.     Dim cName As String
  50.     cName = Layout.CanonicalMediaName
  51.     For i = LBound(cNames) To UBound(cNames)
  52.       sName = Layout.GetLocaleMediaName(cNames(i))
  53.       If lName = sName Then
  54.         cName = cNames(i)
  55.         Exit For
  56.       End If
  57.     Next
  58.     GetCanonicalFromLocalName = cName
  59. End Function
Должен работать в принципе для любого принтера.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #133 : 01-06-2017, 17:13:32 »
Александр Ривилис , спасибо Вам большое за помощь!!! Все работает как хотел :)

Оффлайн wavaw

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #134 : 02-06-2017, 13:18:51 »
а у меня возникла проблема с уроком "пакетная печать". если печатать построчно через f8 и ждать когда распечатается каждый лист, то все получается. если запустить скрипт на авто выполнение, то печатается только первый лист.
на сколько я понимаю, это происходит от того, что первый лист начинает печататься "в фоне" и последующие задания на печать акад в таком случае игнорирует.
введение в код строчки
Код - Visual Basic [Выбрать]
  1. backgroundplot = 0
не решило проблему

сам код полностью:
Код - Visual Basic [Выбрать]
  1. ' 3. Batch printing of specific blocks-formats
  2. Sub PlotByBlocks()
  3.  
  4.     Dim objEnt As AcadEntity
  5.     Dim objBRef As AcadBlockReference
  6.     Dim pt1 As Variant
  7.     Dim pt2(0 To 1) As Double
  8.     Dim i As Integer
  9.    
  10.     Dim arr() As AcadEntity
  11.     Dim arr2() As AcadEntity
  12.  
  13.     ' Create a selection with a frame
  14.    
  15.     On Error Resume Next
  16.  
  17.     ThisDrawing.SelectionSets("SS").Delete
  18.     Set ss = ThisDrawing.SelectionSets.Add("SS")
  19.     ss.SelectOnScreen
  20.    
  21.     i = 0
  22.     For Each objEnt In ss
  23.         ReDim Preserve arr(i)
  24.         Set arr(i) = objEnt
  25.         i = i + 1
  26.     Next
  27.    
  28.     k = 0
  29.     For i = LBound(arr) To UBound(arr)
  30.        If arr(i).Layer = "Vramka" Then
  31.             ReDim Preserve arr2(k)
  32.             Set arr2(k) = arr(i)
  33.             k = k + 1
  34.        End If
  35.     Next
  36.  
  37. ' We work if the name of the A1 block
  38.    k = 0
  39.     For i = LBound(arr2) To UBound(arr2)
  40.         BlockProp = arr2(i).GetDynamicBlockProperties
  41.         If arr2(i).EffectiveName = "Mega Ramka" And BlockProp(4).Value = "A3-a" Then
  42.             pt1 = arr2(i).InsertionPoint
  43.             pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  44.             ReDim Preserve pt1(0 To 1)
  45.             pt2(0) = pt1(0) + 420 * MyScale
  46.             pt2(1) = pt1(1) + 297 * MyScale
  47.             k = k + 1
  48.             PolyPlot "c:\Users\wavaw\Desktop\А3_" + CStr(k), pt1, pt2
  49.         End If
  50.     Next
  51.    
  52. End Sub
  53. Sub PolyPlot(strFileName As String, pt1 As Variant, pt2 As Variant)
  54.  
  55.     ' Декларируем
  56.    Dim Layout As AcadLayout
  57.          
  58.     ' Устанавливаем
  59.    Set Layout = ThisDrawing.ActiveLayout
  60.        
  61.     Layout.RefreshPlotDeviceInfo
  62.            
  63.     ' Print Settings
  64.    'backgroundplot = 0
  65.    Layout.ConfigName = "DWG to PDF.pc3"
  66.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  67.     Layout.CenterPlot = True
  68.     Layout.PlotRotation = ac0degrees
  69.     Layout.StandardScale = acScaleToFit
  70.     Layout.StyleSheet = "monochrome.ctb"
  71.    
  72.     ' We set the frame and type of window
  73.    Layout.SetWindowToPlot pt1, pt2
  74.     Layout.PlotType = acWindow
  75.    
  76.     ' We send to the press
  77.    ThisDrawing.Regen acAllViewports
  78.     ThisDrawing.Plot.PlotToFile strFileName
  79.        
  80. End Sub