Witam
Zaimportowałem IGES ze złożenia. Solidworks tworzy dla mnie wszystkie części, ale dla każdej z nich muszę przeprowadzić diagnostykę importu, aby naprawić powierzchnie.
Czy istnieje sposób na naprawienie wszystkich części bez otwierania ich 1 po 1?
Nie
Witam
O ile mi wiadomo, nie jest to możliwe, ale za pomocą makra jest to z pewnością możliwe.
Miłego dnia
No tak, w końcu zrobiłem makro, zajęło mi to 5 minut. Nie trzeba szukać dalej, chociaż fajnie by było mieć dedykowaną funkcję :)
Witam
Czy możesz się nim podzielić?
Nawet jeśli jest zwięzły, może być praktyczny.
Dziękuję
Nie jestem profesjonalistą VBA, po prostu majstrowałem, ale to działa. Umieściłem również BrowseFolder.
Opcja jawna
Dim swApp jako SldWorks.SldWorks
Przyciemnij swModel jako SldWorks.ModelDoc
Dim sFileName As Ciąg
Dim FileName As Ciąg
Przyciemnij ścieżkę jako ciąg
Przyciemnij nowąŚcieżkę jako ciąg
Dim swLayerMgr jako SldWorks.LayerMgr
Przyciemnij swLayer jako SldWorks.Layer
Dim nErrors tak długo, jak długo
Dim nWarnings tak długo, jak długo
Dim boolstatus As Boolean
Dim longstatus As Long
Przyciemnij długie ostrzeżenia tak długo
Prywatny Const BIF_RETURNONLYFSDIRS Tak długi = &H1
Prywatny Const BIF_DONTGOBELOWDOMAIN Tak długo = &H2
Prywatny Const BIF_RETURNFSANCESTORS Tak długo = &H8
Prywatny Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Prywatny Const BIF_BROWSEFORPRINTER Tak długi = &H2000
Prywatny Const BIF_BROWSEINCLUDEFILES Tak długi = &H4000
Prywatny Const MAX_PATH Tak długo = 260
Funkcja BrowseFolder(opcjonalny podpis jako ciąg, opcjonalny folder początkowy jako ciąg) jako ciąg
Przyciemnij folder jako obiekt
Przyciemnij F jako folder
Dim ShellApp jako obiekt
Ustaw ShellApp = CreateObject("Shell.Application")
Ustaw F = ShellApp.BrowseForFolder(0&; Podpis, BIF_RETURNONLYFSDIRS, FolderPoczątkowy)
Jeśli nie, F jest niczym, to
Jeśli F = "Pulpit", to
BrowseFolder = Informacje("PROFIL UŻYTKOWNIKA") & "\Pulpit"
Inaczej
BrowseFolder = F.Items.Item.Path
Zakończ jeżeli:
Zakończ jeżeli:
Zakończ funkcję
Sub main()
Ustaw swApp = Application.SldWorks
' Wybór folderu źródłowego
Path = BrowseFolder(Caption:="Wybierz folder źródłowy")
Jeśli ścieżka = "" to
'MsgBox "Wybierz folder źródłowy"
Koniec
Inaczej
Ścieżka = Ścieżka & "\"
Zakończ jeżeli:
sFileName = Dir(Ścieżka & "*.sldprt")
Rób, aż sFileName = ""
Ustaw swModel = swApp.OpenDoc6(Ścieżka + nazwaPliku, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Ustaw swModel = swApp.ActiveDoc
longstatus = swModel.ImportDiagnosis(Prawda, Fałsz, Prawda, 0)
Dim swErrors tak długo
Dim swOstrzeżenia tak długo
boolstatus = swModel.Save3(1, swErrors, swWarnings)
swApp.CloseDoc swModel.GetTitle
Ustaw swModel = Nic
sFileName = Katalog
Pętla
Koniec subwoofera