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

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

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

Оффлайн Dimaill

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #165 : 20-04-2018, 12:04:53 »
Добрый день!

Подскажите пожалуйста по моей проблеме:
Посмотрел видео урок "16. AutoCAD VBA. Пакетная печать блоков-форматов"
Скопировал себе код, создал блок для печати. Названия блоков в коде VBA и самом блоке совпадают. Параметры печати проверил-совпадают.
Ничего более не менял в коде, запускаю, выбираю рамкой блоки для печати (более 1 блока).
В результате на печать выводится 1 лист pdf.
В чем может быть проблема?
(Даже пробовал делать все как у автора: те же названия блоков, места для печати и т.д.) Итог один-печатается только 1 блок.

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

  • Administrator
  • *****
  • Сообщений: 12560
  • Карма: 1632
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #166 : 20-04-2018, 12:18:10 »
В результате на печать выводится 1 лист pdf.
Посмотрел код - он должен формировать столько pdf-файлов (не листов в файле, а именно файлов), сколько выбрано блоков с правильным именем.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Dimaill

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #167 : 20-04-2018, 12:23:55 »
Все верно, должно напечататься столько файлов pdf сколько выбрано блоков с именем указанном в коде. Так вот я выбираю например 3 блока, печатается 1 файл. И сколько бы я не выбрал одинаковых блоков- печатается только 1.

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

  • Administrator
  • *****
  • Сообщений: 12560
  • Карма: 1632
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #168 : 20-04-2018, 15:20:54 »
Все верно, должно напечататься столько файлов pdf сколько выбрано блоков с именем указанном в коде. Так вот я выбираю например 3 блока, печатается 1 файл. И сколько бы я не выбрал одинаковых блоков- печатается только 1.
Запусти под отладчиком и посмотри что происходит. Подозреваю, что у тебя BACKGROUNDPLOT не установлена в 0: https://knowledge.autodesk.com/ru/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2017/RUS/AutoCAD-Core/files/GUID-713029B7-B5AC-4860-BE2E-74878D418EA4-htm.html
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Dimaill

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #169 : 20-04-2018, 15:32:07 »
Помогло, спасибо Вам) Печатает как сумасшедший)

Оффлайн Dimaill

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #170 : 20-04-2018, 16:50:47 »
Подскажите пожалуйста.
Хочу присвоить имени листа атрибут блока, чтобы как то идентифицировать напечатанное. Что я делаю не так? Только не пинайте сильно. Я не разбираюсь в VBA. Все происходит наощупь (пытаюсь разобраться)

Код - Visual Basic [Выбрать]
  1. ' 3. Печать заданных блоков в пдф
  2. Sub PlotByBlocks()
  3.  
  4.     Dim objEnt As AcadEntity
  5.     Dim objBRef As AcadBlockReference
  6.     Dim blockRef As AcadBlockReference
  7.     Dim pt1 As Variant
  8.     Dim pt2(0 To 1) As Double
  9.     Dim i As Integer
  10.    
  11.     ' Создаем выбор рамкой
  12.    On Error Resume Next
  13.     ThisDrawing.SelectionSets("SS").Delete
  14.     Set ss = ThisDrawing.SelectionSets.Add("SS")
  15.     ss.SelectOnScreen
  16.    
  17.     ' Работаем, если имя блока А1
  18.    For Each objEnt In ss
  19.     If objEnt.ObjectName = "AcDbBlockReference" Then
  20.     Set objBRef = objEnt
  21.         If objBRef.EffectiveName = "_ЛИСТ" Then
  22.             pt1 = objBRef.InsertionPoint
  23.             pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  24.             ReDim Preserve pt1(0 To 1)
  25.             pt2(0) = pt1(0) + 841
  26.             pt2(1) = pt1(1) + 594
  27.         End If
  28.         att = blockRef.GetAttributes
  29.                      For i = LBound(att) To UBound(att)
  30.                          If att(i).TagString = "№" Then
  31.                          PolyPlot "C:\Users\dilyasov\Desktop\PDF\Лист" + CStr(att(№)), pt1, pt2
  32.                          End If
  33.                      Next
  34.      End If
  35.      Next
  36.    
  37. End Sub
  38.  
« Последнее редактирование: 20-04-2018, 17:31:05 от Александр Ривилис »

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

  • Administrator
  • *****
  • Сообщений: 12560
  • Карма: 1632
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #171 : 20-04-2018, 17:32:15 »
Dimaill
Прочитай у меня в подписи по поводу форматирования кода на нашем форуме и соблюдай это правило!
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

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

  • Administrator
  • *****
  • Сообщений: 12560
  • Карма: 1632
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #172 : 20-04-2018, 17:38:00 »
Не проверял, но думаю, что вместо:
Код - Visual Basic [Выбрать]
  1.   PolyPlot "C:\Users\dilyasov\Desktop\PDF\Лист" + CStr(att(№)), pt1, pt2
должно быть:
Код - Visual Basic [Выбрать]
  1.   PolyPlot "C:\Users\dilyasov\Desktop\PDF\Лист" + CStr(att(i).TextString), pt1, pt2
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн serega374

  • ADN OPEN
  • Сообщений: 41
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #173 : 08-07-2018, 06:17:43 »
Добрый день! А как проверить что ячейка Exel пустая? пробовал "" и 0 не помогает. В Excel VBA есть  метод isEmpty(). Но в автокаде он не работает
Код - Visual Basic [Выбрать]
  1. For NumRowsExel = 1 To 100 ' цикл в котором определяю начальную строку таблицы АФУ
  2. dataString = Cells(NumRowsExel, NumColumnExel) ' переменная в которой храню значение текущей ячейки, NumColumnExel=1
  3. If dataString = "Сектора" Then ' проверяю ключевое слово "Сектора" - начало таблицы АФУ
  4. RowsBeginTableAFU = NumRowsExel ' номер строки начала таблицы АФУ
  5. End If
  6. Next
  7.  
  8. For NumRowsExel = RowsBeginTableAFU To 100 ' цикл в котором определяю конечную строку таблицы АФУ
  9. dataString = Cells(RowsBeginTableAFU, NumColumnExel) ' переменная в которой храню значение текущей ячейки, NumColumnExel=1
  10. If dataString = "" Then ' проверяю пуста ли ячейка, если да
  11. RowsEndTableAFU = NumRowsExel - 1 ' вычисляю номер строки конца таблицы АФУ
  12. GoTo 1 ' и выхожу за пределы цикла
  13. End If
  14. Next
  15.  
  16. 1
  17. NumRowsTable_AFU = RowsEndTableAFU - RowsBeginTableAFU ' вычисляю число строк таблицы АФУ
  18. NumColumnTable_AFU = 1 ' число столбцов
  19. Set New_Table_AFU = ThisDrawing.ModelSpace.AddTable(BasePointTable, NumRowsTable_AFU, NumColumnTable_AFU, 50, 50) ' вставляю таблицу
  20. End Sub
  21.  

И каким образом заполнить вставленную  таблицу в автокаде значениями из exel, не могу найти метод

Оффлайн serega374

  • ADN OPEN
  • Сообщений: 41
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #174 : 08-07-2018, 07:18:28 »
метод isEmpty(). Но в автокаде он не работает
Извините работает
Код - Visual Basic [Выбрать]
  1. x = RowsBeginTableAFU ' номер строки начала таблицы
  2. Do While IsEmpty(Cells(x, NumColumnExel)) = False ' пока не пуста
  3. x = x + 1' увеличиваем
  4. Loop
  5. RowsEndTableAFU = x ' если пуста записываем предыдущее х как номер строки конца таблицы АФУ
  6. NumRowsTable_AFU = RowsEndTableAFU - RowsBeginTableAFU ' вычисляю число строк таблицы АФУ

Оффлайн vsb

  • ADN OPEN
  • Сообщений: 2
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #175 : 17-08-2018, 06:57:54 »
Здравствуйте!
Изучив уроки, написал небольшую программку по выводу чертежей из модели в pdf файлы. Большое спасибо автору. Решил добавить возможность настройки способа вывода и качества из секции "ВЭкраны с раскрашиванием" окна вывода на Печать из Модели. Но не смог найти какие системные переменные или свойства объектов возможно использовать для реализации этой задачи. Прошу подсказать каким образом можно это сделать или где почитать об этом. Извините за возможное неправильное использование терминов, так как уровень в программировании начальный. Система Windows 8.1, Autocad 2012.

Оффлайн Вильдар

  • ADN Club
  • ****
  • Сообщений: 395
  • Карма: 69
  • Skype: vildar82
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #176 : 17-08-2018, 08:05:32 »
Про визуальный стиль:
у объекта видового экрана (ViewportTableRecord) есть свойство визуальный стиль VisualStyleId (DBVisualStyle), а у него есть Type.
Вроде это оно.

Оффлайн vsb

  • ADN OPEN
  • Сообщений: 2
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #177 : 17-08-2018, 10:36:52 »
Большое спасибо, будем разбираться.
 :)

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #178 : 18-01-2021, 16:34:43 »
Код - 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.         If objBRef.EffectiveName = "А4кшб" Or objBRef.EffectiveName = "ОУ" Or objBRef.EffectiveName = "Титул" Then
  39.         pt1 = objBRef.InsertionPoint
  40.         varAttributes = objBRef.GetAttributes
  41.         l = varAttributes(4).TextString
  42.         ReDim Preserve pt1(0 To 1)
  43.         pt2(0) = pt1(0) + 21000
  44.         pt2(1) = pt1(1) + 29700
  45.         format = "A4к"
  46. ElseIf objBRef.EffectiveName = "ОД" Or objBRef.EffectiveName = "А3ашб" Then
  47.         pt1 = objBRef.InsertionPoint
  48.         ReDim Preserve pt1(0 To 1)
  49.         pt2(0) = pt1(0) + 42000
  50.         pt2(1) = pt1(1) + 29700
  51.         format = "A3а"
  52.         ElseIf objBRef.EffectiveName = "А3кшб" Then
  53.         pt1 = objBRef.InsertionPoint
  54.         ReDim Preserve pt1(0 To 1)
  55.         pt2(0) = pt1(0) + 29700
  56.         pt2(1) = pt1(1) + 42000
  57.         format = "A3к"
  58.         ElseIf objBRef.EffectiveName = "А2ашб" Then
  59.         pt1 = objBRef.InsertionPoint
  60.         ReDim Preserve pt1(0 To 1)
  61.         pt2(0) = pt1(0) + 59400
  62.         pt2(1) = pt1(1) + 42000
  63.         format = "A2а"
  64.         ElseIf objBRef.EffectiveName = "А2кшб" Then
  65.         pt1 = objBRef.InsertionPoint
  66.         ReDim Preserve pt1(0 To 1)
  67.         pt2(0) = pt1(0) + 42000
  68.         pt2(1) = pt1(1) + 59400
  69.         format = "A2к"
  70.         ElseIf objBRef.EffectiveName = "А1ашб" Then
  71.         pt1 = objBRef.InsertionPoint
  72.         ReDim Preserve pt1(0 To 1)
  73.         pt2(0) = pt1(0) + 84100
  74.         pt2(1) = pt1(1) + 59400
  75.         format = "A1а"
  76.         ElseIf objBRef.EffectiveName = "А1кшб" Then
  77.         pt1 = objBRef.InsertionPoint
  78.         ReDim Preserve pt1(0 To 1)
  79.         pt2(0) = pt1(0) + 59400
  80.         pt2(1) = pt1(1) + 84100
  81.         format = "A1к"
  82.         ElseIf objBRef.EffectiveName = "А0ашб" Then
  83.         pt1 = objBRef.InsertionPoint
  84.         ReDim Preserve pt1(0 To 1)
  85.         pt2(0) = pt1(0) + 11890
  86.         pt2(1) = pt1(1) + 84100
  87.         format = "A0а"
  88.         ElseIf objBRef.EffectiveName = "А0кшб" Then
  89.         pt1 = objBRef.InsertionPoint
  90.         ReDim Preserve pt1(0 To 1)
  91.         pt2(0) = pt1(0) + 84100
  92.         pt2(1) = pt1(1) + 11890
  93.         format = "A0к"
  94.         i = i + 1
  95.         PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(n) + " - ИЧ Лист " + CStr(l) + " - ", pt1, pt2, format
  96.         End If
  97.     End If
  98.     Next
  99. End Sub
  100. Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant)
  101.     Dim Layout As AcadLayout
  102.     Set Layout = acadDoc.ActiveLayout
  103.     Layout.RefreshPlotDeviceInfo
  104.     Layout.ConfigName = "DWG To PDF.pc3"
  105.     acadDoc.SetVariable "BACKGROUNDPLOT", 0
  106.     If format = "A4к" Then
  107.     Layout.CanonicalMediaName = "ISO_full_bleed_A4_(210.00_x_297.00_MM)"
  108.     If format = "A3а" Then
  109.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  110.     If format = "A3к" Then
  111.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(297.00_x_420.00_MM)"
  112.     If format = "A2а" Then
  113.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(594.00_x_420.00_MM)"
  114.     If format = "A2к" Then
  115.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(420.00_x_594.00_MM)"
  116.     If format = "A1а" Then
  117.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(841.00_x_594.00_MM)"
  118.     If format = "A1к" Then
  119.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(594.00_x_841.00_MM)"
  120.     If format = "A0а" Then
  121.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(1189.00_x_841.00_MM)"
  122.     If format = "A0к" Then
  123.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(841.00_x_1189.00_MM)"
  124.     Layout.CenterPlot = True
  125.     Layout.PlotRotation = ac0degrees
  126.     Layout.StandardScale = acScaleToFit
  127.     Layout.StyleSheet = "acad.ctb"
  128.     Layout.SetWindowToPlot pt1, pt2
  129.     Layout.PlotType = acWindow
  130.     acadDoc.Regen acAllViewports
  131.     acadDoc.Plot.PlotToFile strFileName
  132. End Sub
Сделал по примерам код - ругается на строке Polyplot - compile error^ Wrong number of arguments or invalid property assignment - Подскажите что не так

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

  • Administrator
  • *****
  • Сообщений: 12560
  • Карма: 1632
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #179 : 18-01-2021, 16:37:26 »
Сделал по примерам код - ругается на строке Polyplot - compile error^ Wrong number of arguments or invalid property assignment - Подскажите что не так
Ну вообще-то у этой PolyPlot четыре аргумента, а ты передаёшь пять...
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение