potřeboval bych poradit s pravidlem pro otevírání výkresů.
Pravidlo spouštím z hlavní sestavy -> zjistím hlavní složku a tu prohledám včetně podsložek -> vytvořím seznam výkresů.
A teď bych potřeboval zjistit zda se daný model výkresu nachází v sestavě (iam) a v sestavě (iam) bych rád zjistil odkazy na výkresy.
Zatím to obcházím přes porovnávání názvů, ale to nemusí vždy fungovat. Stačí výkres přejmenovat a je to jinde než má být.
Tady je kopie kódu co používám.
Sub Main()
'Cesta k projektu.
CestaProjektu = ThisDoc.WorkspacePath()
'Testuje soubor na sestavu. Nelze spustit z dílu nebo výkresu.
If ThisApplication.Activedocument.documentType = kAssemblydocumentObject Then
' Nalezne všechny podsložky OldVersions a smaže je
For Each foundDirectory As String In My.Computer.FileSystem.GetDirectories(CestaProjektu,FileIO.SearchOption.SearchAllSubDirectories,"OldVersions")
My.Computer.FileSystem.DeleteDirectory(foundDirectory,FileIO.DeleteDirectoryOption.DeleteAllContents)
Next
'Ve složce projektu prohledá podsložky a nelazne všechny výkresy a zapíše je do seznamu.
Dim SeznamVykresu3 As New ArrayList
Dim SeznamVykresu4 As New ArrayList
For Each foundFile As String In My.Computer.FileSystem.GetFiles(CestaProjektu,Microsoft.VisualBasic.FileIO.SearchOption.SearchAllSubDirectories, "*.idw")
SeznamVykresu3.Add(foundFile)
Dim FNamePos6 As Long
Dim docFName6 As String
FNamePos6 = InStrRev(foundFile, "\", -1)
docFName6 = Mid(foundFile, FNamePos6 + 1, Len(foundFile) - FNamePos6-4)
SeznamVykresu4.Add(docFName6)
Next
' MessageBox.Show(SeznamVykresu4.Count, "Počet nalezených výkresů.")
' Nalezne všechny podsestavy a díly v hlavní sestavě
Dim Seznam7 As New ArrayList
Dim doc7 As document
Seznam7.add(ThisDoc.FileName(False))
For Each doc7 In ThisApplication.Activedocument.AllReferenceddocuments
Dim FNamePos7 As Long
Dim docFName7 As String
FNamePos7 = InStrRev(doc7.FullFileName, "\", -1)
docFName7 = Mid(doc7.FullFileName, FNamePos7 + 1, Len(doc7.FullFileName) - FNamePos7-4)
If doc7.ComponentDefinition.BOMStructure = "51970" Then
Seznam7.add(docFName7)
' MessageBox.Show(docFName7, "Sestava")
End If
Next
' MessageBox.Show(Seznam7.Count, "Počet souborů v sestavě.")
' Porovná nalezené soubory a vrátí seznam schodných souborů
Dim Seznam8 As New ArrayList
For k = 0 To SeznamVykresu4.Count-1 Step 1
foundVal8 = MultiValue.FindValue(Seznam7, "=", SeznamVykresu4(k))
If Len(foundVal8) <> 0 Then
Seznam8.add(SeznamVykresu4(k))
' Otevře všechny výkresy aktivních součástí.
Dim odoc As Drawingdocument = ThisApplication.Documents.Open(SeznamVykresu3(k), True)
auto = iLogicVb.Automation
auto.RunExternalRule(odoc, "AKTUALIZACE_VÝKRESU")
End If
Next
If Seznam8.Count = 0 Then
MessageBox.Show("Adresář neobsahuje výkresy.", "Neexistují výkresy.")
End If
MessageBox.Show(Seznam8.Count, "Počet výkresů, které se podařilo otevřít.")
Else
MessageBox.Show("Testovaný soubor není sestava. Toto pravidlo lze spustit pouze v sestavě.", "Zkontroluj umístění projektu a souburu!")
End If
End Sub