Einen Leichnam retten

Out of category
1

Allo Gruppe,

Ich bin neu in diesem Forum. Ich arbeite mit mechanisch geschweißten Maschinen, also mit mehreren Karosserien. Ich möchte einige Körper als STEP, IGES-Datei speichern, da mein Press Controller nur diesen Dateityp öffnen kann. Es gibt die Funktion zum Speichern des Körpers (Einfügen / Funktion / Text speichern), aber sie erlaubt es mir, nur in  * zu speichern. SLDPRT

Haben Sie Vorschläge für eine weitere Funktion? Ansonsten gibt es Makro-Profis in dem Bereich, ich muss zugeben, dass ich nicht allzu viel darüber weiß, aber ich kann ein Makro sehen, das einen Körper in einen neuen Raum einfügt, ohne ihn zu speichern, und das das Teil in STEP und nicht die Suite mit dem vordefinierten Namen in einem Parameter speichern würde.

Vielen Dank an alle

2

Hallo

Sie müssen nur eine Konfiguration erstellen und (mit der Funktion "delete/keep body") löschen, was Ihr Controller nicht benötigt, und es als STEP speichern.

3 „Gefällt mir“
3

Hallo

Versuchen Sie Folgendes:

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 „Gefällt mir“
4

Hallo Jerome P,

Sie haben verstanden, was ich leider wollte, um die Linie einen Körper auszuwählen, es blockiert. Ich habe das Feld, das sich öffnet, aber ich kann keine Auswahl treffen, ich kann einfach OK drücken und das Makro wird beendet. Ich hoffe, Sie können mir helfen. Vielen Dank.

5

WOWOWOOWOOOOO

Ich habe gerade festgestellt, dass ich den Text auswählen muss, bevor ich das Makro starte, es ist zu viel zum Ankreuzen. Ich weiß nicht, ob Sie mir helfen können, die Funktion zu ändern, aber ich möchte nur ein Dialogfeld hinzufügen, mit dem Sie die Datei umbenennen oder noch besser den Namen der Körpergruppe anstelle des Namens des Körpers verwenden können. In meinem Beispiel möchte ich den Namen "30320.1 - PL0.25" anstelle des Standardnamens "save body1" verwenden, siehe Bild

Vielen Dank

 


capture.png
6

OKAY. Versuchen Sie Folgendes:

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 „Gefällt mir“
7

OK, es funktioniert 50-50 :(

Beim Testen funktioniert die Funktion "getcutlist" gut, da die Variable "FilePath" immer gut ist. Auf der anderen Seite  funktioniert das "savetofile3" nicht. Ich kann auf dem Bildschirm sehen, dass die Funktion ausgeführt wird, weil sie den Raum öffnet , aber die Datei nicht im Verzeichnis erscheint.

Auf der anderen Seite habe ich bei Tests eines festgestellt:

  Zuerst verwende ich die Verzeichniseigenschaft "description" und SW benennt meine Verzeichnisse automatisch um. (siehe caption2), aber wenn ich diesen Parameter noch nicht bearbeitet habe, z.B. das letzte Teileverzeichnis (items-list-of-welded-parts19) oder wenn ich es manuell umbenenne. Zum Beispiel das erste Verzeichnis (test), dann funktioniert das Makro gut und die Schrittdatei erscheint im Verzeichnis.

Glauben Sie, dass es die Klammern sein könnten, die SW standardmäßig am Ende schreibt und die für I don't know what verwendet werden?

des Typs   "... <#>... "  

Vielen Dank.

 


capture2.png
8

Wenn der Dateiname ungültige Zeichen enthält, wird er nicht gespeichert.

Ersetzt: FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & GetCutList(swModel, swBody.Name) & ". SCHRITT"

by: FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & RegexStr(GetCutList(swModel, swBody.Name)) & ". SCHRITT"

und fügt die Funktion hinzu:

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 „Gefällt mir“
9

Wow toll!!

Ich habe am Ende von regex.pattern() einen Punkt hinzugefügt. Muster = "[^-_ a-zA-Z0-9.] "), weil die Funktion sie gelöscht hat (Danke Google).

Vielen Dank für Ihre Unterstützung, ich werde es nie alleine schaffen.

Du bist ein Gott des Programmierens und ich möchte einer deiner Schüler werden. :)

Nochmals vielen Dank, du machst mir den Tag...

 

2 „Gefällt mir“