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

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

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

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Ага, этот отрывок.

Пройдитесь пошагово по скрипту. После строчки: varAttributes = objBRef.GetAttributes откройте Locals и раскройте плюсик у varAttributes.
Вы увидите сколько элементов в массиве, из чего состоит каждый элемент, что такое TagString,TextString. Мне очень помогло залипание в Locals.


 

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Под остальные форматы получается также делать отдельные модули или все таки где-то лучше объединить с условием?
под А4:
Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks_А4к() 'Tools -> References-> подключить библиотеку AutoCAD 20XX Type Library
  2. On Error Resume Next
  3. Dim acadApp As AcadApplication
  4. Dim acadDoc As AcadDocument
  5. Dim n As Integer ' ДОБАВИЛ 2
  6. With Sheets("!")
  7. .Activate
  8. n = .Range("B" & 1).Value ' ДОБАВИЛ 2
  9. End With
  10. Set acadApp = GetObject(, "AutoCad.Application")
  11. Set acadDoc = acadApp.ActiveDocument
  12. If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  13.    acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  14. End If
  15.     Dim objEnt As AcadObject
  16.     Dim objBRef As AcadBlockReference
  17.     Dim pt1 As Variant
  18.     Dim pt2(0 To 1) As Double
  19.     Dim i As Integer
  20.     Dim varAttributes As Variant ' ДОБАВИЛ
  21.    Dim l As Variant ' ДОБАВИЛ
  22. Dim ss As AcadSelectionSet
  23. Set ss = acadDoc.SelectionSets.Item("SS")
  24. If ss Is Nothing Then
  25.     Set ss = acadDoc.SelectionSets.Add("SS")
  26. Else
  27.     ss.Clear ' если используем сущ. SS то очистить его
  28. End If
  29. ss.SelectonScreen
  30. On Error GoTo 0
  31.     i = 0
  32.     For Each objEnt In ss
  33.     If objEnt.ObjectName = "AcDbBlockReference" Then
  34.     Set objBRef = objEnt
  35.         If objBRef.EffectiveName = "А4кшб" Then
  36.         pt1 = objBRef.InsertionPoint
  37.         varAttributes = objBRef.GetAttributes
  38.         l = varAttributes(4).TextString
  39.         ReDim Preserve pt1(0 To 1)
  40.         pt2(0) = pt1(0) + 21000
  41.         pt2(1) = pt1(1) + 29700
  42.         i = i + 1
  43.         PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(n) + " - ИЧ Лист " + CStr(l) + " - А4к", pt1, pt2
  44.         End If
  45.     End If
  46.     Next
  47. End Sub
  48. Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant)
  49.     Dim Layout As AcadLayout
  50.     Set Layout = acadDoc.ActiveLayout
  51.     Layout.RefreshPlotDeviceInfo
  52.     Layout.ConfigName = "DWG To PDF.pc3"
  53.     acadDoc.SetVariable "BACKGROUNDPLOT", 0
  54.     Layout.CanonicalMediaName = "ISO_full_bleed_A4_(210.00_x_297.00_MM)"
  55.     Layout.CenterPlot = True
  56.     Layout.PlotRotation = ac0degrees
  57.     Layout.StandardScale = acScaleToFit
  58.     Layout.StyleSheet = "acad.ctb"
  59.     Layout.SetWindowToPlot pt1, pt2
  60.     Layout.PlotType = acWindow
  61.     acadDoc.Regen acAllViewports
  62.     acadDoc.Plot.PlotToFile strFileName
  63. End Sub

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Господа, а если допустим сделать блок динамический
с шагом по "ДЛИНА" = 210,297,420,594,841,1189
и с шагом по "ШИРИНА" = 210,297,420,594,841,1189
Код - Visual Basic [Выбрать]
  1. varBlockProperties = objBRef.GetDynamicBlockProperties
  2. For Index = LBound(varBlockProperties) To UBound(varBlockProperties)
  3. Set prop = varBlockProperties(Index)
  4. If prop = prop.PropertyName = "ДЛИНА" Then
  5. x1 = varBlockProperties(Index).TextString
  6. ElseIf prop = prop.PropertyName = "ШИРИНА" Then
  7. y1 = varBlockProperties(Index).TextString
А вот дальше как-то нужно параметры печати приделать по условиям - пока не понимаю как
Еще бы хорошо научиться ловить параметр блока масштаб и его в умножающий коэффициент для условий координат применять.
А также интересно как программно нестандартный формат задать допустим 1400х594 и убрать ширину полей в созданном листе

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Я бы сделал так.
Создаем динамический блок с атрибутами.
В "Таблице свойств блока" забиваем типоразмеры.

динамические свойства:
   длина
   ширина
атрибуты
   формат -- название формата (скорее для удобства пользования )
   ориентация -- тут указываем ориентацию что бы  назначить Layout.PlotRotation = ac0degrees
   каноническое название формата -- сюда забиваем название формата пример:"ISO_full_bleed_A4_(210.00_x_297.00_MM)"
В "Таблице свойств блока" забиваем типоразмеры.




В коде потом вытаскиваем массив динамических свойств и перебором вытаскиваем инфу по нужным переменным
Аналогично пробегаемся по атрибутам

Таким образом один блок закрывает много форматов

UPD.
Забыл добавить. Точку вставки блока располагаем так что бы это был левый нижний угол (т.е. переменная pt1 в коде), соответственно pt2=pt1+длина(ширина)

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Layout.PlotRotation = ac0degrees - насколько я понял ориентация и для книжного и для альбомного всегда такая. x и y меняются местами в координатах.
там я еще про масштаб дописал в предыдущем сообщении - тоже кажется нужный параметр
и про нестандартные листы создать если такой в списке отсутствует
Сам блок я разобрался как создать динамический примерно - не понимаю как по условиям задать разные форматы в нижней части кода там где Sub PolyPlot

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Левый нижний угол не подойдет вариант будет правый только чтоб штамп не съезжал. Но тогда нужно как-то по другому вычислять рамку печати правый угол имеем и длина ширина параметры знаем.
Значит из точки определения блока из координаты x надо вычесть "Длина", y так и остается с плюсом
Так же у меня остался вопрос что можно дописать чтоб публикация в один файл проходила с отдельным своим именем и отдельно по листу тоже печаталась

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Вот тут примеры по печати, последние по печати нескольких листов (видимо в один файл, не пробовал)
http://www.alex160570.narod.ru/AcadVBA/vba10.htm

по поводу нестандартных листов, у меня не получалось ни до стучаться до сущ. настроек  форматов в .pc3, ни создавать свои форматы в .pc3 программно.
По этому я вижу вариант подготовить (либо самому нашпиговать, либо скачать откуда) файл с настройками печати где будут все форматы.
Эти форматы занести в блок.

 "не понимаю как по условиям задать разные форматы в нижней части кода там где Sub PolyPlot" - копайте тему передача параметров в процедуру. Точки Вы ведь уже передаете

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

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Nutson,
Ни в одном из публичных AutoCAD API нет возможности создавать нестандартные форматы. Есть сторонняя библиотека для .NET для работы с pc3-файлами.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Nutson, подскажи пожалуйста как можно многострочный текст из ячейки эксель по координатам в кад отправить. (с динамическими столбцами задать ширину столбца промежуток и выравнивание по ширине)

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Вопрос такой возник а что поменять в коде чтоб пдф не открывались после создания

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Вопрос такой возник а что поменять в коде чтоб пдф не открывались после создания
Надо снять галочку в настройке принтера:


Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Nutson, подскажи пожалуйста как можно многострочный текст из ячейки эксель по координатам в кад отправить. (с динамическими столбцами задать ширину столбца промежуток и выравнивание по ширине)

Мне кажется админ нас выгонит отсюда, так как вопрос уже не по теме топика.

Для начала надо понять какая цель преследуется.
Если надо просто вставить таблицу из ексель в автокад, то тут без кода можно обойтись:


Если цель заполнять штампы, то я бы советовал смотреть в сторону автокадовского "Поля" (http://cadsupport.ru/2015/09/%D1%84%D0%B8%D1%88%D0%BA%D0%B8-autocad-%D0%BF%D0%BE%D0%BB%D1%8F/)
и что бы это поле ссылалось на пользовательское свойство (http://vbamodel.narod.ru/AutoCAD/idh_SummaryInfo_Object.htm)
Я себе сделал такую таблицу:


Ну если реально просто текст вставлять то идешь сюда:http://www.alex160570.narod.ru/AcadVBA/vba01.htm
глава номер 5 - работа с текстами. Инфу из ячеек брать уже умеешь, текст как создать есть по ссылке

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

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Мне кажется админ нас выгонит отсюда, так как вопрос уже не по теме топика.
Выгонять не буду, но правило "Один вопрос - одна тема" никто не отменял.
Так что,Timofeev,  для каждого вопроса создавай новую тему.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Nutson,  вот что для нескольких форматов с условиями получилось - не работает - что-то делаю не так
Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks() 'Tools -> References-> подключить библиотеку AutoCAD 20XX Type Library
  2. On Error Resume Next
  3. Dim acadApp As AcadApplication
  4. Dim acadDoc As AcadDocument
  5. Dim n As Integer ' ДОБАВИЛ 2
  6. With Sheets("!")
  7. .Activate
  8. n = .Range("B" & 1).Value ' ДОБАВИЛ 2
  9. End With
  10. Set acadApp = GetObject(, "AutoCad.Application")
  11. Set acadDoc = acadApp.ActiveDocument
  12. If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  13.    acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  14. End If
  15.     Dim objEnt As AcadObject
  16.     Dim objBRef As AcadBlockReference
  17.     Dim pt1 As Variant
  18.     Dim pt2(0 To 1) As Double
  19.     Dim i As Integer
  20.     Dim varAttributes As Variant ' ДОБАВИЛ
  21.    Dim l As Variant ' ДОБАВИЛ
  22.    Dim format As String ' ДОБАВИЛ 3
  23. Dim ss As AcadSelectionSet
  24. Set ss = acadDoc.SelectionSets.Item("SS")
  25. If ss Is Nothing Then
  26.     Set ss = acadDoc.SelectionSets.Add("SS")
  27. Else
  28.     ss.Clear ' если используем сущ. SS то очистить его
  29. End If
  30. ss.SelectonScreen
  31. On Error GoTo 0
  32.     i = 0
  33.     For Each objEnt In ss
  34.     If objEnt.ObjectName = "AcDbBlockReference" Then
  35.     Set objBRef = objEnt
  36.     varAttributes = objBRef.GetAttributes
  37.     l = varAttributes(4).TextString
  38.     A4к = 0
  39.     A3а = 0
  40.          If objBRef.EffectiveName = "А4кшб" Or objBRef.EffectiveName = "Титул" Then
  41.         pt1 = objBRef.InsertionPoint
  42.         varAttributes = objBRef.GetAttributes
  43.         l = varAttributes(4).TextString
  44.         ReDim Preserve pt1(0 To 1)
  45.         pt2(0) = pt1(0) + 21000
  46.         pt2(1) = pt1(1) + 29700
  47.         A4к = A4к + 1
  48.         format = "A4к"
  49.         ElseIf objBRef.EffectiveName = "ОД" Or objBRef.EffectiveName = "А3ашб" Then
  50.         pt1 = objBRef.InsertionPoint
  51.         ReDim Preserve pt1(0 To 1)
  52.         pt2(0) = pt1(0) + 42000
  53.         pt2(1) = pt1(1) + 29700
  54.         A3а = A3а + 1
  55.         format = "A3а"
  56.          i = i + 1
  57.         PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(n) + " - ИЧ Лист " + CStr(l) + " - ", pt1, pt2, format
  58.         End If
  59.     End If
  60.     Next
  61. End Sub
  62. Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant, format As String)
  63.     Dim Layout As AcadLayout
  64.     Set Layout = acadDoc.ActiveLayout
  65.     Layout.RefreshPlotDeviceInfo
  66.     Layout.ConfigName = "DWG To PDF.pc3"
  67.     acadDoc.SetVariable "BACKGROUNDPLOT", 0
  68.     If format = "A4к" Then
  69.     Layout.CanonicalMediaName = "ISO_full_bleed_A4_(210.00_x_297.00_MM)"
  70.     ElseIf format = "A3а" Then
  71.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  72.     End If
  73.     Layout.CenterPlot = True
  74.     Layout.PlotRotation = ac0degrees
  75.     Layout.StandardScale = acScaleToFit
  76.     Layout.StyleSheet = "acad.ctb"
  77.     pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False) ' добавил по статье https://adn-cis.org/pechat-granicz-okna-pri-pomoshhi-vba.html
  78.    pt2 = acadDoc.Utility.TranslateCoordinates(pt2, acWorld, acDisplayDCS, False) ' добавил по статье https://adn-cis.org/pechat-granicz-okna-pri-pomoshhi-vba.html
  79.    Layout.SetWindowToPlot pt1, pt2
  80.     Layout.PlotType = acWindow
  81.     acadDoc.Regen acAllViewports
  82.     acadDoc.Plot.PlotToFile strFileName
  83. End Sub

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Что делаете не так:
-выложили код без чертежа на котором его надо тестировать;
-не описали поведение кода. Он ломается? или он просто ничего не произошло?

Делайте отступы в коде. Если открыли блок If то сделайте внутри него отступ - так будет наглядней намного.
Возможно код не отработал от того что строки 56,57 попали в блок условия Elseif.

по строкам 77,78. У Вас изначально в скрипте они были, но почему то при исполнении скрипт на ней спотыкался и я их закомментировал.
Возможно и сейчас скрипт об них спотыкается, так как в 33 строке я отключал игнорирование ошибок