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

[FocusNIK]

Насколько я понял из этого : http://vbamodel.narod.ru/AutoCAD/idh_insertionpoint.htm
object.InsertionPoint применяется для:  Attribute, AttributeReference, BlockRef, ExternalReference, MInsertBlock, MText, Shape, Text, Tolerance Symbol

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

[Алексей Кулик]

Судя по тому, что я вижу, 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

Пошаговая отладка многое покажет

[Владимир П]

если приложили пример использования с атрибутами блока

Ну, вот если из моего примера, то вот так заработало

Код - 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, но... зачем?

[wavaw]

здравствуйте.
код со второго урока ошибку выдаёт :"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

с первой же строчки ошибка

[Александр Ривилис]

wavaw
Библиотека Microsoft Excel подключена?

[wavaw]

да, действительно галочка "слетела".

[AskarZ]

Здравствуйте! Спасибо Вам за прекрасный макрос печати. Использую код из 14 урока. Поменял принтер на PDFCreator. Появилась проблема, он не печатает А0, А1, А2 и не стандартные форматы (типа А4х3), с др. форматами нормально.

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

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

[Александр Ривилис]

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

Изменить нужно видимо строку:

Код - Visual Basic [Выбрать]

1. Layout.CanonicalMediaName = "A1"

[AskarZ]

Изменить нужно видимо строку:

VBA я толком незнаю, а на что конкретней нужно поменять? Спасибо

[Александр Ривилис]

VBA я толком незнаю, а на что конкретней нужно поменять? Спасибо

Тут не вопрос знания VBA, а вопрос знания того, какое каноническое имя для PDFCreator для локального имени "A1". Вот на это имя и нужно поменять.

[AskarZ]

Тут не вопрос знания VBA, а вопрос знания того, какое каноническое имя для PDFCreator для локального имени "A1". Вот на это имя и нужно поменять.

Спасибо, буду разбираться

[Александр Ривилис]

Обрати внимание на эту картинку:



Возможно еще зависит и от версии PDFCreator и/или версии AutoCAD.

[Александр Ривилис]

Я немного поигрался и сделал такой код:

Код - 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

Должен работать в принципе для любого принтера.

[AskarZ]

Александр Ривилис , спасибо Вам большое за помощь!!! Все работает как хотел

[wavaw]

а у меня возникла проблема с уроком "пакетная печать". если печатать построчно через 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