Zobrazit plnou verzi příspěvku: Jak získat plné jméno modelu výkresu ze sestavy

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

17zidek
17.07.2020, 09:01
Dobrý den,zjistit z výkesu referencovaný/é model/y lze, ale z modelu zjistit zda má výkres nelze.Mohl byste popsat co myslíte "odkazem na výkresy"?

Adamito
17.07.2020, 20:16
Dobrý den,odkaz na výkres je myšleno, jak píšete, zda má model výkres.¨Jak tedy zjistit z výkresu referenční model, když otevírám pravidlo v hlavní sestavě?Děkuji za odpověd.

17zidek
20.07.2020, 10:52
Dobrý den,referencovaný výkres získáte z otevřeného
výkresu takže například upravením Vaší smyčky na prohledání adresáře a
získání všech výkresů a v proměnné 'mujDoc' budete mit prvni
referencovany soubourFor Each foundFile As String In My.Computer.FileSystem.GetFiles(CestaProjektu, Microsoft.VisualBasic.FileIO.SearchOption.SearchTopLevelOnly, "*.idw")
Try
Dim drawing As DrawingDocument = ThisApplication.Documents.Open(foundFile,False)
Dim mujDoc As Document = drawing.ReferencedDocuments.Item(1)
drawing.Close(True)
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)
Catch
End Try
Next

Bylo by dobré dodělat ověření zda soubor je součástí sestavy, a také ověření/zpracování pokud má výkres více referencovaných souborů a asi předělat posloupnost pravidla celkově.


Adamito
21.07.2020, 18:54
Dobrý den,mockrát děkuji za pomoc.Tady byl můj zakopaný pes Dim mujDoc As Document = drawing.ReferencedDocuments.Item(1)Jak píšete níže, pravidlo jsem poupravil, popřehazoval a přidal test jestli je soubor v sestavě. Ověření na více referenčních modelů jsem nepřidal, jelikož používáme pouze jeden referenční soubor pro výkres.Ještě jednou díky, díky, díky.