Пакетная печать VBA из листа со многими ВЭ

Автор Тема: Пакетная печать VBA из листа со многими ВЭ  (Прочитано 16170 раз)

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

Оффлайн Alexdt20gtАвтор темы

  • ADN OPEN
  • Сообщений: 2
  • Карма: 0
Добрый день! Только начал изучать VBA, ваши уроки очень помогают! Но возник вопрос следующего характера:
Пакетная печать по блоку прекрасно работает в пространстве модели, но иногда приходят чертежи выполненные в "одном листе". То есть множество форматок раскидано на листе 1 и создано множество ВЭ.При запуске макроса печать  из пространства листе ничего не происходит, но стоит один лист напечатать из листа через рамку как макрос находит и выводит на печать все указанные форматы на данном листе.
Через MsgBox определил что "вылетает" после прохождения строки выбора формата листа. Как я понимаю это связанно с настройками листа заданными при его создании, а точнее тем что по умолчанию выставлена печать "лист".
Хотя в макросе и идет переопределение способа печати на рамку, печатать он отказывается

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

  • Administrator
  • *****
  • Сообщений: 1096
  • Карма: 172
Alexdt20gt, приветствую на форуме!
Топик отделил от исходной темы - к обсуждению видеоуроков по VBA вопрос не имеет отношения. Настоятельно рекомендую привести свой (или используемый) код и пример файла. Из файла dwg можно предварительно удалить всю секретную информацию и выполнить его очистку.
Все, что сказано - личное мнение.

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

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

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
При запуске макроса печать  из пространства листе ничего не происходит
Попробуй вот так:
Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks()
  2.  
  3.     Dim objEnt As AcadEntity
  4.     Dim objBRef As AcadBlockReference
  5.     Dim pt1 As Variant
  6.     Dim pt2(0 To 1) As Double
  7.     Dim i As Integer
  8.    
  9.     ' Создаем выбор рамкой
  10.    On Error Resume Next
  11.     ThisDrawing.SelectionSets("SS").Delete
  12.     Set ss = ThisDrawing.SelectionSets.Add("SS")
  13.     ss.SelectOnScreen
  14.        
  15.     ' Работаем, если имя блока А1
  16.    i = 0
  17.     For Each objEnt In ss
  18.     If objEnt.ObjectName = "AcDbBlockReference" Then
  19.     Set objBRef = objEnt
  20.         If objBRef.EffectiveName = "A1" Then
  21.             pt1 = objBRef.insertionPoint
  22.             pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  23.             ReDim Preserve pt1(0 To 1)
  24.             pt2(0) = pt1(0) + 841
  25.             pt2(1) = pt1(1) + 594
  26.             i = i + 1
  27.             PolyPlot "c:\Users\evthi\Desktop\Тест" + CStr(i), pt1, pt2
  28.         End If
  29.     End If
  30.     Next
  31.    
  32. End Sub
  33. Sub PolyPlot(strFileName As String, pt1 As Variant, pt2 As Variant)
  34.  
  35.     ' Декларируем
  36.    Dim Layout As AcadLayout
  37.          
  38.     ' Устанавливаем
  39.    Set Layout = ThisDrawing.ActiveLayout
  40.        
  41.     Layout.RefreshPlotDeviceInfo
  42.            
  43.     ' Настройка печати
  44.    Layout.ConfigName = "DWG to PDF.pc3"
  45.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(594.00_x_841.00_MM)"
  46.     'Layout.CenterPlot = True
  47.    Layout.PlotRotation = ac90degrees
  48.     Layout.StandardScale = acScaleToFit
  49.     Layout.StyleSheet = "acad.ctb"
  50.  
  51.     ' Устанавливаем рамки и тип окошка
  52.    Layout.SetWindowToPlot pt1, pt2
  53.     Layout.PlotType = acWindow
  54.    
  55.     ' Отправляем на печать
  56.    ThisDrawing.Regen acAllViewports
  57.     ThisDrawing.Plot.PlotToFile strFileName
  58.        
  59. End Sub

Оффлайн Alexdt20gtАвтор темы

  • ADN OPEN
  • Сообщений: 2
  • Карма: 0
Добрый день! Побывал такой вариант, результата нет.
Так же побывал
    'Layout.CenterPlot = True
    'Layout.PlotRotation = ac90degrees
печатать отказывается.
Мне кажется это связано с "особым" порядком задания параметров в пространстве листа (если он есть).
Параллельно анализирую код !Plot_U там проблема решается сменой пространства ModelSpace на PaperSpace, но в нашем (точнее вашем) коде пространство задано более универсально и все работает, но при условии выпуска 1 листа рамкой вручную. Продолжаю разбираться. Спасибо за быстрый ответ

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Alexdt20gt, добрый день! Задача будет решена быстрее, если Вы приложите файл чертежа с рамками в листах.

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Во вложении пример в dwg с блоком! и файл Excel с кодом - но не работает потому что не умею. Прикрепленный архив
В файле dwg блок есть. Должно по нажатию кнопки активировать кад, выделить мышью зону должен пользователь и напечатать в pdf все блоки. Желательно создать по дороге папку по пути файла эксель и сохранить туда pdf
Помогите разобраться, плиз!

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Я написал комментарии по местам где были ошибки

Желательно просмотреть уроки отсюда: https://adn-cis.org/forum/index.php?topic=7270.0

Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks()
  2. 'Tools -> References-> подключить библиотеку AutoCAD 20XX Type Library
  3. '
  4. '
  5. Dim acadApp As AcadApplication
  6. Dim acadDoc As AcadDocument
  7.  
  8. 'Получаем ссылку на приложение автокада
  9. Set acadApp = GetObject(, "AutoCad.Application")
  10. Set acadDoc = acadApp.ActiveDocument
  11.  
  12. If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  13.    acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  14. End If
  15.  
  16.     Dim objEnt As AcadObject
  17.     Dim objBRef As AcadBlockReference
  18.     Dim pt1 As Variant
  19.     Dim pt2(0 To 1) As Double
  20.     Dim i As Integer
  21.  
  22. Dim ss As AcadSelectionSet
  23. 'Проверить существует ли  набор с таким именем
  24. Set ss = acadDoc.SelectionSets.Item("SS")
  25. 'если не существует то создаем
  26. If ss Is Nothing Then
  27.     Set ss = acadDoc.SelectionSets.Add("SS")
  28. End If
  29.  
  30. ss.SelectonScreen
  31.  
  32. On Error Resume Next
  33.     i = 0
  34.     For Each objEnt In ss
  35.     'У вас было  не правильное имя
  36.    If objEnt.ObjectName = "AcDbBlockReference" Then
  37.     Set objBRef = objEnt
  38.         If objBRef.EffectiveName = "А1ашб" Then
  39.         pt1 = objBRef.InsertionPoint
  40.         pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  41.         ReDim Preserve pt1(0 To 1)
  42.         pt2(0) = pt1(0) + 84100
  43.         pt2(1) = pt1(1) + 59400
  44.         i = i + 1
  45.         'так как код запускается из Екселя, мы не можем ссылаться на  ThisDrawling, нужно в процедуру PolyPlot передать ссылку на документ автокада
  46.        'ActiveWorkbook.Path -- путь вашего екселя
  47.        PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(i), pt1, pt2 ' желательно по пути файла Excel сохранить в папку из ячейки B1
  48.        End If
  49.     End If
  50.     Next
  51. End Sub
  52. Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant)
  53.     Dim Layout As AcadLayout
  54.     'замена ThisDrawling на ссылку чертежа в автокад
  55.    Set Layout = acadDoc.ActiveLayout
  56.     Layout.RefreshPlotDeviceInfo
  57.     Layout.ConfigName = "DWG To PDF.pc3"
  58.    
  59.         'в видео Максим Маркевич акцентировал что имя формата должно быть на английском с заменой пробелов на нижнее подчеркивание
  60.    Layout.CanonicalMediaName = "ISO_full_bleed_A1_(841.00_x_594.00_MM)"
  61.     Layout.CenterPlot = True
  62.     Layout.PlotRotation = ac0degrees
  63.     Layout.StandardScale = acScaleToFit
  64.     Layout.StyleSheet = "acad.ctb"
  65.     Layout.SetWindowToPlot pt1, pt2
  66.     Layout.PlotType = acWindow
  67.    
  68.     'замена ThisDrawling на ссылку чертежа в автокад
  69.    acadDoc.Regen acAllViewports
  70.     acadDoc.Plot.PlotToFile strFileName
  71. End Sub
  72.  
  73.  

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Подключил 2017 библиотеку
Set ss = acadDoc.SelectionSets.Item("SS") ' здесь дает ошибку: Run-time error '-2145386476 (80200014)': Ключ не найден

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Забил откорректировать. Перенесите 32 строку в самое начало

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
появляется файл plot.log
Пдф не появляются

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
На моем компьютере код исполнился и отпечатал ПДФ.
Поэтому проблема может быть в каких нибудь настройках в вашем автокаде может.
Умеете запускать пошаговую отладку? Нажимайте клавишу F8 - одно нажатие один шаг программы.
Откройте окно locals  на вкладке View - тут можно смотреть значения переменных по ходу исполнения кода

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Вот перенес On Error Resume Next
Распечатался один только лист 1.pdf Листы 2 и 3 не появились. Довольно таки долго в фоновом режиме он печатал этот лист
Поглядите код в модуле может что-то не так сделал?
Еще раз попробовал пдф 1 лист а должно быть 3

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Отпечатал без проблем)
может у вас стоит галочка "печатать в фоновом режиме"?
попробуйте прикрепленный ексель, я там дописал:
"acadDoc.SetVariable "BACKGROUNDPLOT", 0 "    - эта строка убирает печать в фоновом режиме

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Спасибо вам огромное !!!!!!!!
Работает прекрасно.
1. Вопрос если к названию нужно добавить цифру из ячейки B1 что надо в имени переписать. Чтоб было: [B1].А1.1 [B1].А1.2 и [B1].А1.3
2. Вопрос если несколько форматов в модели допустим А4 и А1
нужно добавить ElseIf objBRef.EffectiveName = "А4" Then и прописать к нему точки.
 А как поменять тогда формат куда печатать?

Новая проблема если больше блоков:
на строке For Each objEnt In ss
ошибка Run-time error '-214748113 (8000ffff)' :
Automation error
Разрушительный сбой

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Выше я дал Вам ссылку на тему с видео уроками от Максима Маркевича, там в самом начале разбирается вопрос как считывать информацию из ячейки екселя.
Что касается разных форматов, то экспериментируйте, первые результаты уже есть у Вас, а там на сколько фантазии хватит накрутить, не думаю что есть единственно верный вариант.
Я б рекомендовал разделять на под процедуры, не писать одну огромную простыню

Используйте пошаговую отладко и смотрите окно Locals. У Вас будет еще очень много ошибок, нужно выработать подход к их решению