Witam
Szukałem i nie mogłem znaleźć małego makra, które eksportuje bieżącą kartę rysunku solidworks w formacie dxf (do cięcia laserowego) z dokładną nazwą bieżącej karty planu jako nazwą pliku
Ktoś ma solucję?
Zauważ, że jestem do bani w programowaniu VBA
Z góry dziękuję
Witam
Spójrz na to makro, wypróbuj je i powiedz mi, czy wszystko z tobą w porządku
Sub main()
Dim swApp jako SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim montab As Variant
Dim montab2 As Variant
Dim montab3 As Variant
Dim inintern As String
Dim Nazwa jako ciąg
Przyciemnij ścieżkę jako ciąg
Przyciemnij nazwę jako ciąg
Przyciemnij ścieżkę pliku jako ciąg
Przyciemnij rozmiar ścieżki tak długo, jak długo
Dim PathNoExtension As Ciąg
Ustaw swApp = Application.SldWorks
Ustaw swModel = swApp.ActiveDoc
ŚcieżkaPliku = swModel.GetPathName
PathSize = Strings.Len(ŚcieżkaPliku)
PathNoExtension = Strings.Left(ŚcieżkaPliku, RozmiarŚcieżki - 7)
montab = Split(swModel.GetPathName, "\", -1)
interm = montab(UBound(montab))
nazwa = Mid(interm, 1, Len(interm) - 7)
montab2 = Split(nazwa, ".", 2)
Nazwa = montab2(0)
'montab3 = Split(nazwa, "$", 2)
'Nazwa = Montab3(1)
path = PathNoExtension & ".dxf" 'format, w którym chcesz zapisać
'pathMEP = swModel.GetPathName
'FullFileName = Mid(MEPPATH, 1, Len(MEPPATH) - 7)
'Elementy = Split(FullFileName, "\", -1)
'FullFileName = Elementy(0)
'MessAlert = MsgBox("Czy akceptujesz ten plik?" + FullFileName, vbYesNo)
'Jeśli MessAlert = vbNo, wyjdź z sub
nazwa = nazwa & " - Arkusz1"
Ustaw część = swApp.ActiveDoc
Ustaw SelMgr = Part.SelectionManager
Ścieżka Part.SaveAs2, 0, Prawda, Fałsz
Part.Save2 Fałsz
Ustaw część = Nic
swApp.CloseDoc swModel.GetTitle
'Set swModel = Nothing: Set swApp = Nothing
Koniec subwoofera
Witam gwygwy
Dziękujemy, to działa!
Ale zapisuje się z nazwą pliku, a nie z nazwą bieżącej karty
Czy można go zmodyfikować?
Z góry dziękuję
Witam
Nie jestem specjalistą, więc udało mi się wpisać nazwę dokumentu i nazwę arkusza, ale nie lepiej.
Sub main()
Dim swApp jako SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim montab As Variant
Dim montab2 As Variant
Dim montab3 As Variant
Dim inintern As String
Dim Nazwa jako ciąg
Dim name2 As Ciąg
Przyciemnij ścieżkę jako ciąg
Przyciemnij nazwę jako ciąg
Przyciemnij ścieżkę pliku jako ciąg
Przyciemnij rozmiar ścieżki tak długo, jak długo
Dim PathSizeTitle tak długo
Dim PathNoExtension As Ciąg
Dim PathNoExtension2 As String
Ustaw swApp = Application.SldWorks
Ustaw swModel = swApp.ActiveDoc
ŚcieżkaPliku = swModel.GetPathName
PathSize = Strings.Len(ŚcieżkaPliku)
PathNoExtension = Strings.Left(ŚcieżkaPliku, RozmiarŚcieżki - 7)
nazwa2 = swModel.GetTitle
montab = Split(swModel.GetPathName, "\", -1)
interm = montab(UBound(montab))
nazwa = Mid(interm, 1, Len(interm) - 7)
montab2 = Split(nazwa, ".", 2)
Nazwa = montab2(0)
PathSizeTitle = Strings.Len(nazwa)
PathNoExtension2 = Strings.Left(PathNoExtension, PathSize - PathSizeTitle - 7)
'montab3 = Split(nazwa, "$", 2)
'Nazwa = Montab3(1)
path = PathNoExtension2 & name2 & ".dxf" 'format, w którym chcesz zapisać
'pathMEP = swModel.GetPathName
'FullFileName = Mid(MEPPATH, 1, Len(MEPPATH) - 7)
'Elementy = Split(FullFileName, "\", -1)
'FullFileName = Elementy(0)
'MessAlert = MsgBox("Czy akceptujesz ten plik?" + FullFileName, vbYesNo)
'Jeśli MessAlert = vbNo, wyjdź z sub
'nazwa = nazwa & " - Arkusz1"
Ustaw część = swApp.ActiveDoc
Ustaw SelMgr = Part.SelectionManager
Ścieżka Part.SaveAs2, 0, Prawda, Fałsz
Part.Save2 Fałsz
Ustaw część = Nic
'swApp.CloseDoc swModel.GetTitle
Set swModel = Nothing: Ustaw swApp = Nic
Koniec subwoofera
@gwygwy proponowane makro jest dalekie od czystości pod względem kodu, zduplikowanego, bezużytecznego kodu... Co więcej, nie rozumiem, skąd wzięła się nazwa arkusza. Jedyna nazwa liścia jest wpisana w mano "Liść1"
Aby wyeksportować plik z nazwą zakładki, zobacz ten temat, na który odpowiedziałem, nie wiedząc, czy odpowiedź Ci odpowiada, czy nie.
https://www.lynkoa.com/forum/solidworks/export-diff%C3%A9renci%C3%A9-en-pdf-et-dxf-des-onglets-de-mise-en-plan-par-une-macro
W razie potrzeby można go dostosować bez umieszczania warunku jeśli Cutout znajduje się w nazwie zakładki i bez usuwania go z nazwy pliku, w razie potrzeby.
Ale generalnie unikamy otwierania 2 bardzo bliskich lub identycznych tematów.
Cześć @sbadenis
Tak, kod nie jest czysty, nie jestem profesjonalistą. Zmodyfikowałem istniejące makro, w którym nadal znajduje się kod, który nie służy żadnemu celowi, ale zachowuję go na wypadek, gdybym potrzebował go w innym makrze.
I nie, on nie jest trafiony, jak mówisz, przed linią jest '. Więc ta linia jest bezużyteczna.
Wracam do zdrowia za pomocą get.title, to wszystko, co znalazłem. Ale jeśli masz makro, które działa dla niego, zrób to, wydaje się, że dobrze kodujesz.
@gwygwy martw się, to było właśnie dla Ciebie! I rzeczywiście, nie widziałem get.title, ale sam w sobie otrzymujesz nazwę dokumentu + nazwę aktywnego arkusza
Aby pobrać nazwę każdego arkusza i wyeksportować każdy arkusz z nazwą arkusza jako nazwą eksportu, należy utworzyć pętlę na arkuszach, tak jak w makrze podanym w łączu. Jeśli jesteście zainteresowani zapraszam do oglądania, nie ma tu nic zbyt skomplikowanego, 2 lata temu nie miałem żadnej wiedzy na temat vba i metodą prób i błędów się w to wkręciłem.
Dla makra zrobiłem jedno w innym temacie, ale brak odpowiedzi @Fennec_Flegmatique wydaje się być nieobecny dla subskrybentów!
Przyjaciele, nie jestem przy abscent subskrybentów
Dziękuję za Wasz wkład i za czas, który poświęciliście na udzielenie mi odpowiedzi
Robię postępy w zrozumieniu kodów (jestem beotianinem), ale jest to trochę długie
Nie rozwiązałem jeszcze swojego tematu
Dam ci znać, jeśli go znajdę lub czy jestem wart!