Adamito
16.07.2020, 21:41
Dobrý den,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.") ElseMessageBox.Show("Testovaný soubor není sestava. Toto pravidlo lze spustit pouze v sestavě.", "Zkontroluj umístění projektu a souburu!")End If End Sub