Попадает к нам многолистовой чертеж с таблицей сварных швов.
Надо найти шов на чертеже или проверить таблицу сварных швов.
С помощью макроса после введения номера сварного шва нам открывается лист чертежа где этот шов впервые показан и выделяются все швы под этим номером на этом листе.
Далее разбираем саму суть макроса. Начало такое же как и во всех макросах: подключаем solid, берём активный документ, проверяем тип документа. Код целиком в конце статьи.
Работа макроса:
- Вводим значение номера сварного шва weld.
- Устанавливаем флаг bool в значение true. Об этом далее.
- При использовании метода GetViews мы получаем массив (листы чертежа) массивов (виды на этом листе). В нашем случае это массив sheetAndViews.
- Создаем цикл по видам в цикле по листам. Берем каждый вид по отдельности swView.
- Проверяем на наличие заметок сварных швов GetWeldSymbolCount.
- Получаем массив (vAnns) заметок сварных швов, метод GetWeldSymbols. Это все сварные швы в этом виде.
- Каждый сварной шов это тоже массив (vAnn), потому что в заметке несколько полей для ввода текста.
- Проходя по каждой ячейке в заметке мы сравниваем значение текста с введенным нами номером шва.
Если мы получаем совпадение:
Если это первое совпадение после запуска макроса флаг (bool=true), то активируется лист чертежа (ActivateSheet) на котором есть вид с этой заметкой сварного шва.
Флаг bool=false - больше во время циклов другие листы чертежа активироваться не будут.
Берем саму заметку (swAnno) и выбираем (bRet).
Переходим к следующей заметке а потом и к виду. Когда виды на листе закончились и (при совпадении) все нужные заметки выбрались (bRet=true), мы обрываем цикл.
Если не было совпадений, то переходим к следующему листу.
Код макроса:
Option Explicit
Dim longstatus As Long, longwarnings As Long
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim Errors As Long
Dim bRet As Boolean
Dim swWeldSymbol As SldWorks.WeldSymbol
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
' Is document active?
If swModel Is Nothing Then
swApp.SendMsgToUser2 "A Drawing file must be open.", swMbWarning, swMbOk
Exit Sub
End If
' Is it a drawing document?
If swModel.GetType <> SwConst.swDocDRAWING Then
swApp.SendMsgToUser2 "A Drawing file must be open.", swMbWarning, swMbOk
Exit Sub
End If
Set swDraw = swModel
Dim swAnno As SldWorks.Annotation
Dim vAnns As Variant
Dim vAnn As Variant
Dim i As Integer
Dim weld As String
weld = InputBox("№ шва", , "№")
Dim bool As Boolean
bool = True
Dim sheetAndViews As Variant
sheetAndViews = swDraw.GetViews
Dim sheetCount As Long
Dim viewCount As Long
Dim views As Variant
For sheetCount = LBound(sheetAndViews) To UBound(sheetAndViews)
views = sheetAndViews(sheetCount)
For viewCount = LBound(views) To UBound(views)
Set swView = views(viewCount)
If swView.GetWeldSymbolCount > 0 Then
vAnns = swView.GetWeldSymbols
If Not IsEmpty(vAnns) Then
For Each vAnn In vAnns
Set swWeldSymbol = vAnn
For i = 0 To swWeldSymbol.GetTextCount() - 1
If InStr(1, swWeldSymbol.GetTextAtIndex(i), weld, vbTextCompare) <> 0 Then
If bool = True Then
swDraw.ActivateSheet (swView.sheet.GetName)
End If
Set swAnno = swWeldSymbol.GetAnnotation
bRet = swAnno.Select(True)
'Debug.Print bRet
bool = False
End If
Next
Next
End If
End If
Next viewCount
If bRet = True Then Exit For
Next sheetCount
End Sub
Желаю творческих успехов. Подписывайтесь на канал.
Напишите в комментариях интересующие темы— разберём их в следующих постах.
#SolidWorks #VBA #Макросы #Автоматизация #Инженерия #Конструирование #Моделирование #Чертежи