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