Witam
Obecnie zastanawiam się nad systemem do sprawdzania nazewnictwa maszyny. Drzewo maszyn jest podzielone na podzbiory, pogrupowane w foldery "funkcji" w drzewie tworzenia.
Idealnie byłoby mieć możliwość wyeksportowania zestawienia materiałów maszyny do Excela , z poszanowaniem grupowania w folderach montażowych. Nie znalazłem sposobu, aby zrobić to bezpośrednio, może dałoby się to zrobić przez VBA? Co myślisz?
Z góry dzięki!
Witam. Poniższe makro wyeksportuje strukturę drzewa, w tym foldery, takie jak:
TopLevelAsm1 > Asm3-1 > Część 4-1
TopLevelAsm1 > Folder1 > Asm2-1
TopLevelAsm1 > Folder1 > Asm2-1 > Część 1-1
Option Explicit
Dim FilePath As String
Sub main()
FilePath = "C:\Temp\myBOM.TSV"
If Dir(FilePath) <> "" Then Kill FilePath
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
TraverseAssyFeatures swModel, Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1, InStrRev(swModel.GetPathName, ".") - InStrRev(swModel.GetPathName, "\") - 1)
End Sub
Sub TraverseAssyFeatures(ByVal swModel As SldWorks.ModelDoc2, ByRef Rep As String)
Dim swComp As SldWorks.Component2
Dim swCompModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swEntity As SldWorks.Entity
Set swFeat = swModel.FirstFeature
While Not swFeat Is Nothing
Set swEntity = swFeat
If swEntity.GetType = swSelectType_e.swSelFTRFOLDER Then
If InStr(swFeat.Name, "EndTag") = 0 Then
Rep = Rep & " > " & swFeat.Name
Else
Rep = Left(Rep, InStrRev(Rep, " > ") - 1)
End If
End If
If swEntity.GetType = swSelectType_e.swSelCOMPONENTS Then
WriteIntoFile Rep & " > " & swFeat.Name
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
Set swComp = swFeat.GetSpecificFeature2
swComp.SetSuppression2 swComponentSuppressionState_e.swComponentFullyResolved
Set swCompModel = swComp.GetModelDoc2
swCompModel.ShowConfiguration2 swComp.ReferencedConfiguration
TraverseAssyFeatures swCompModel, Rep & " > " & swFeat.Name
End If
End If
Set swFeat = swFeat.GetNextFeature
Wend
End Sub
Sub WriteIntoFile(logSTR As String)
Dim My_fileNum As Integer
My_fileNum = FreeFile
Open FilePath For Append As #My_fileNum
Print #My_fileNum, logSTR
Close #My_fileNum
End Sub
Witam
Dziękuję bardzo!
Chciałem to przetestować, ale mam błąd 91 w następującym wierszu:
swCompModel.ShowConfiguration2 swComp.ReferencedConfiguration
zmienna obiektowa lub zmienna blokowa z niezdefiniowaną wartością
Plik został utworzony, ale jest w nim tylko jeden wiersz
Czy masz jakieś pojęcie o pochodzeniu problemu? Z góry dzięki!
Ta linia nie jest konieczna, jeśli części mają tylko jedną konfigurację (lub są zapisane w konfiguracji używanej w złożeniu). Więc możesz go usunąć.
Nie powinno to jednak powodować błędu. Sprawdza, czy składnik jest prawidłowy z:
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
Set swComp = swFeat.GetSpecificFeature2
If swComp is Nothing then Debug.print "Problème comp avec: " & swFeat.Name
Set swCompModel = swComp.GetModelDoc2
If swCompModel is Nothing then Debug.print "Problème modèle avec: " & swFeat.Name
If Not swCompModel is Nothing then
'Debug.Print "Config Name: " & swComp.ReferencedConfiguration
'swCompModel.ShowConfiguration2 swComp.ReferencedConfiguration
TraverseAssyFeatures swCompModel, Rep & " > " & swFeat.Name
End If
End If
Jeśli możesz wysłać mi zespół z częścią, która powoduje problem, przyjrzę się temu.
Mam ten sam błąd (91) na linii
Set swCompModel = swComp.GetModelDoc2
Poprzez przetaczanie linii tego bloku generowany jest mój plik.
Ten blok służy do przetwarzania podzespołów. Jeśli zespół nie ma podzespołów, można pozostawić go wyłączonym lub użyć:
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
Set swComp = swFeat.GetSpecificFeature2
If swComp is Nothing then Debug.print "Problème comp avec: " & swFeat.Name
If Not swComp is Nothing then
Set swCompModel = swComp.GetModelDoc2
If swCompModel is Nothing then Debug.print "Problème modèle avec: " & swFeat.Name
If Not swCompModel is Nothing then
'Debug.Print "Config Name: " & swComp.ReferencedConfiguration
'swCompModel.ShowConfiguration2 swComp.ReferencedConfiguration
TraverseAssyFeatures swCompModel, Rep & " > " & swFeat.Name
End If
End If
End If
Inaczej:
Co mówi "natychmiastowe" okno? (Widok menu > natychmiast)
Naprawdę nie mogę pomóc więcej, nie mając plików.
Nie znalazłem okna "natychmiastowego"... Czy to jest okno wykonywania VBA?
Z tego, co widziałem, błąd występuje w pierwszej części pierwszego podzbioru w pierwszym folderze drzewa ("Problem z komp: 23495-4364-2")
Folder i podzbiór pojawiają się w pliku, ale część nie.
W tym oknie:
I znowu: "Naprawdę nie mogę bardziej pomóc, nie mając plików".
Przepraszamy, nie mogę wysłać mojego zestawu w takiej postaci, w jakiej jest, ze względu na ochronę prywatności. Myślę, że zrobię kilka testów z montażem testowym, jeśli z tego nie wyjdę, wyślę Ci to do pogłębienia.
Dziękuję za pomoc w każdym razie!
Nie potrzebuję projektu części.
Zrób kopię zespołu, otwórz każdą z części, usuń funkcje, zapisz.
Zobacz załączony plik. Nawiasem mówiąc, możesz sprawdzić za pomocą tego zespołu, czy to działa.
Witam
Makro podane na początku dyskusji działa bardzo dobrze, wystarczy ustawić wszystkie komponenty na rozwiązane przed jego uruchomieniem, w przeciwnym razie powoduje błędy, ponieważ lekkie komponenty nie są dostępne, stąd komunikat o błędzie "zmienna obiektu lub zmienna blokowa z niezdefiniowaną".
Pozdrowienia
Dziękuję d.roger.
Oryginalny kod został zmieniony w celu uwzględnienia:
swComp.SetSuppression2 swComponentSuppressionState_e.swComponentFullyResolved
Po: Ustaw swComp = ...
Dziękuję d.roger i JeromeP!
Niestety zawsze otrzymuję komunikat o błędzie podczas uruchamiania makra, albo po przekazaniu wszystkich części do rozwiązania, albo po dodaniu linii (zawiesza się na danej linii).
To powiedziawszy, na początku działa, ponieważ nadal mam kilkanaście wierszy w pliku TSV.
Zamierzam przetestować z częściami "od zera", aby zobaczyć, czy mam te same problemy, będę Cię informować na bieżąco!
Czy masz wcześniej ten sam problem z zestawem dołączonym jako załącznik 3 wiadomości?
Tak, wykonanie utknęło w następującym wierszu:
swComp.SetSuppression2 swComponentSuppressionState_e.swComponentFullyResolved
W trybie debugowania widzę, że wartość swComponentSuppressionState_e.swComponentFullyResolved wynosi 2.
Właśnie zrobiłem test z pustymi częściami, makro wykonuje się poprawnie.
Czy uważasz, że ten problem może być związany z konfiguracją części lub z użyciem PDM?
Tak, prawdopodobnie pochodzi z PDM, aby przetestować najnowszą wersję wszystkich plików, aby umieścić je w lokalnej pamięci podręcznej...
Makra stworzone do pracy z PDM nie są w ogóle zbudowane w ten sam sposób, musisz polegać na interfejsach API Epdm, aby połączyć się z repozytorium, pobrać plik do lokalnej pamięci podręcznej itp. To już nie jest ta sama praca...
Wartość 2 dla swComponentSuppressionState_e.swComponentFullyResolved jest normalna.
Problem z SetSuppression2 może również dotyczyć PDM. Możesz spróbować swComp.SetSuppression2 swComponentSuppressionState_e.swComponentResolved
Zrobiłem "najnowszą wersję" na wszystkich plikach (i zmodyfikowałem linię kodu JeromeP), eksportuje dobrze, ale zawiesza się na 1. podzbiorze drzewa.