Grupa Allo,
Jestem nowy na tym forum. Pracuję na maszynach spawanych mechanicznie, czyli z wieloma korpusami. Chciałbym zapisać niektóre ciała jako plik STEP, IGES, ponieważ mój kontroler prasowy może otworzyć tylko ten typ pliku. Jest funkcja zapisywania treści (wstawianie/ funkcja/zapisywanie treści), ale pozwala mi ona zapisywać tylko w *. SLDPRT (Biblioteka SLDPRT)
Czy masz jakieś sugestie dotyczące innej funkcji? W przeciwnym razie w okolicy są profesjonaliści od makr, muszę przyznać, że nie znam się na tym zbyt wiele, ale widzę makro, które wstawiłoby ciało w nowym pomieszczeniu bez zapisywania go i które zapisałoby część w STEP, a nie w pakiecie, używając predefiniowanej nazwy w parametrze.
Dziękuję Wam wszystkim
Witam
Wystarczy, że utworzysz konfigurację i usuniesz (za pomocą funkcji "usuń/zachowaj treść") to, czego Twój kontroler nie potrzebuje i zapiszesz to jako KROK.
3 polubienia
Witam
Spróbuj tego:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim FilePath As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then MsgBox "Ouvrir une pièce": Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Ouvrir une pièce": Exit Sub
Set swPart = swModel
If swModel.SelectionManager.GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelSOLIDBODIES Then MsgBox "sélectionner un corps": Exit Sub
Set swBody = swModel.SelectionManager.GetSelectedObject6(1, -1)
If swBody Is Nothing Then MsgBox "sélectionner un corps": Exit Sub
swBody.Select2 False, Nothing
FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1) & " - " & swBody.Name & ".STEP"
swPart.SaveToFile3 FilePath, swSaveAsOptions_e.swSaveAsOptions_Silent, swCutListTransferOptions_e.swCutListTransferOptions_FileProperties, False, Empty, Empty, Empty
Set swModel = swApp.ActiveDoc
swApp.CloseDoc swModel.GetTitle
End Sub
4 polubienia
Witaj Jerome P,
Zrozumiałeś co chciałem niestety do linii do wybrania ciała, blokuje się. Mam okno, które się otwiera, ale nie mogę dokonać żadnego wyboru, mogę po prostu nacisnąć OK i kończy makro. Mam nadzieję, że możesz mi pomóc. Bardzo dziękuję.
WOWOWOOWOOOOO
Właśnie złapałem, że muszę wybrać treść przed uruchomieniem makra, to za dużo do zaznaczenia. Nie wiem, czy możesz mi pomóc zmodyfikować funkcję, ale chciałbym tylko dodać okno dialogowe, aby umożliwić Ci zmianę nazwy pliku lub jeszcze lepiej użyć nazwy grupy treści, a nie nazwy treści. W moim przykładzie chciałbym użyć nazwy "30320.1 - PL0.25" zamiast domyślnej nazwy "save body1", patrz obrazek
Dziękuję
capture.png
OK. Spróbuj tego:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim FilePath As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then MsgBox "Ouvrir une pièce": Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Ouvrir une pièce": Exit Sub
Set swPart = swModel
If swModel.SelectionManager.GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelSOLIDBODIES Then MsgBox "sélectionner un corps": Exit Sub
Set swBody = swModel.SelectionManager.GetSelectedObject6(1, -1)
If swBody Is Nothing Then MsgBox "sélectionner un corps": Exit Sub
swBody.Select2 False, Nothing
FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & GetCutList(swModel, swBody.Name) & ".STEP"
swPart.SaveToFile3 FilePath, swSaveAsOptions_e.swSaveAsOptions_Silent, swCutListTransferOptions_e.swCutListTransferOptions_FileProperties, False, Empty, Empty, Empty
Set swModel = swApp.ActiveDoc
swApp.CloseDoc swModel.GetTitle
End Sub
Function GetCutList(swModel As SldWorks.ModelDoc2, BodyName As String) As String
Dim swFeat As SldWorks.Feature
Dim swBodyFolder As SldWorks.BodyFolder
Dim swBody As SldWorks.Body2
Dim vBodies As Variant
Dim vBody As Variant
Set swFeat = swModel.FirstFeature
While Not swFeat Is Nothing
If swFeat.GetTypeName = "CutListFolder" Then
Set swBodyFolder = swFeat.GetSpecificFeature
vBodies = swBodyFolder.GetBodies
If Not IsEmpty(vBodies) Then
For Each vBody In vBodies
Set swBody = vBody
If swBody.Name = BodyName Then
GetCutList = swFeat.Name
Exit Function
End If
Next
End If
End If
Set swFeat = swFeat.GetNextFeature
Wend
GetCutList = BodyName
End Function
2 polubienia
OK, działa 50-50 :(
Podczas testowania funkcja "getcutlist" działa dobrze, ponieważ zmienna "FilePath" jest zawsze dobra. Z drugiej strony "savetofile3" nie działa. Na ekranie widzę, że funkcja jest uruchomiona, ponieważ otwiera pokój, ale plik nie pojawia się w katalogu.
Z drugiej strony, robiąc testy, zdałem sobie sprawę z jednej rzeczy:
Po pierwsze, używam właściwości katalogu "description", a oprogramowanie automatycznie zmienia nazwy moich katalogów. (patrz podpis 2), ale jeśli jeszcze nie edytowałem tego parametru, na przykład ostatniego katalogu części (items-lista-części-spawanych19) lub jeśli zmienię jego nazwę ręcznie. Na przykład pierwszy katalog (test), następnie makro działa dobrze, a plik kroku pojawia się w katalogu.
Myślisz, że to mogą być nawiasy, które SW domyślnie pisze na końcu i które są używane nie wiem do czego?
typu "... <#>... "
Dziękuję.
capture2.png
Rzeczywiście, jeśli w nazwie pliku znajdują się nieprawidłowe znaki , nie zostanie on zapisany.
Zastępuje: FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & GetCutList(swModel, swBody.Name) & ". KROK"
przez: FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & RegexStr(GetCutList(swModel, swBody.Name)) & ". KROK"
i dodaje funkcję:
Function RegexStr(ByVal Str As String) As String
Str = Split(Str, "<")(0)
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
With regex
.Pattern = "[^-_ a-zA-Z0-9]"
.Global = True
.IgnoreCase = True
.MultiLine = False
End With
RegexStr = regex.Replace(Str, "")
End Function
1 polubienie
Wow, świetnie!!
Dodałem kropkę na końcu regex.pattern(. Wzorzec = "[^-_ a-zA-Z0-9.]"), ponieważ funkcja je usunęła (Dzięki Google).
Dziękuję za wsparcie, nigdy nie dam rady zrobić tego sam.
Jesteś bogiem programowania i chciałbym stać się jednym z Twoich uczniów. :)
Jeszcze raz dziękuję, sprawiasz, że mój dzień...
2 polubienia