Добрый день! Решил поделиться небольшим кодом который написал для себя. Чтото наковырял по урокам, чтото додумал по справке.
Как работает:
Создаем чертеж. Вставляем вид сборки. Выбираем этот вид и запускаем правило. Скрытно открывается Сборка из вида и проходит по ней собирая все пути всех вхождений в список.
После этого, по каждому пути из списка ищет файл чертежа этого вхождения и (если имеется чертеж) копируются все листы в созданный чертеж.
Кому-то может пригодиться, допиливать там есть что. У меня структура проектов такова, что в разных сборках много повторяемых нестандартных деталей. и выход проекта должен быть в одной pdf. Поэтому чтобы не плодить копии сделаны чертежи этих деталей в тех же папках что и файлы деталей. В любом случае после этих действий я иногда еще вручную сортирую порядок чертежей.
Class ThisRule
Dim fName As String
Dim Name As String
Dim Path As String
Dim Names(1000) As String ' тут сомнительно..
Dim Count As Integer
Public Sub Main()
Dim oPartName As String 'файл сборки выбранного вида
Dim oAsmDoc As AssemblyDocument 'сборка из вида
'получаем имя файла сборки из вида
Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.ActiveDocument
oPartName = oDrawDoc.SelectSet.Item(1).ReferencedFile.FullFileName
'открываем сборку скрыто(потому что false)
oAsmDoc = ThisApplication.Documents.Open(oPartName, False)
'проходим по всем входжениям и собираем список путей
Call TraverseAssembly(oAsmDoc.ComponentDefinition.Occurrences)
'открываем файлы чертежей и копируем листы
For i = 0 To Count - 1
Path = Left$(Names(i), InStrRev(Names(i), "\"))'получение пути из полного имени
fName = Right$(Names(i), Len(Names(i)) - InStrRev(Names(i), "\"))'получение имени файла без пути
Name = Left$(fName, InStrRev(fName, ".") -1)'получение имени файла без пути и расширения
'вроде проверка наличия нужного файла чертежа
Dim drawingFilename As String
drawingFilename = ThisApplication.DesignProjectManager.ResolveFile(Path, Name + ".idw")
If drawingFilename <> "" Then
Dim oDDoc As DrawingDocument
Dim oSheet As Sheet
oDDoc = ThisApplication.Documents.Open(drawingFilename, False)
'копируем все листы
For q = 1 To oDDoc.Sheets.Count'копируем все листы
Dim nSheet As Sheet
oSheet = oDDoc.Sheets.Item(q)
nSheet = oSheet.CopyTo(oDrawDoc)
nSheet.Name = Name
Next
oDDoc.Close
End If
Next
oAsmDoc.Close
End Sub
'проход по деталям и подсборкам и внесение их полных путей в список имен.
'повторяющиеся имена пропускаются.
Function TraverseAssembly(Occurrences As ComponentOccurrences)
Dim oOcc As ComponentOccurrence
For Each oOcc In Occurrences
oName = oOcc.Definition.Document.FullFileName
If Count = 0 Then
Names(0) = oName
Count = Count + 1
Else
Dim q As Integer
q=0
For i = 0 To Count
If Names(i)=oName Then
q=q+1
End If
Next
If q = 0 Then
Names(Count) = oName
Count = Count + 1
End If
End If
If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
Call TraverseAssembly(oOcc.SubOccurrences)
End If
Next
End Function
End Class
вставлять в правило ilogic. Вообще пришлось писать потому что не нашел в интернете. Еще бы сделать обновление отдельных чертежей - бывают правки отдельных деталей и тогда во всех сборках эти правки нужны тоже. Код рабочий,но если знающие люди смогут чтото улучшить буду благодарен.
первый пост не судите строго)
