PDF-DXF-STEP aus einem Plan

Out of category
1

Hallo
Ich habe es geschafft, vorhandene Makros, die ich von rechts und links gesammelt habe, zu kombinieren.
Dank Ihnen ist meine Arbeit viel einfacher.

Ich habe es geschafft, dieses Makro mit einer Indexverwaltung zu erstellen, die das Überschreiben eines vorhandenen Index vermeidet, aber ich verstehe nicht, warum der .step für einen Übersichtsplan nicht funktioniert und das erste Stück öffnet und die . Schritt. Ich dachte, ich würde die Datei aus der ersten Ansicht des Plans öffnen.
Ich gehe um das Problem herum, ohne es zu sehen.

Es muss bei all dem kleine Fehler oder Ungereimtheiten geben, aber ich habe das Gefühl, dass ich die Lösung berühre.

Der Fehler befindet sich im Abschnitt "Vorbereiten des 3D für STEP"

Vielen Dank an alle, für die VBA eine natürliche Sprache ist. Ich bewundere dich^^

saisissez ou collez d'PDF DXF & STEP indicé.swp - ------------10 / 11 / 2023'

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swView          As SldWorks.View
Dim Filepath        As String
Dim FileName        As String
Dim boolstatus      As Boolean
Dim longstatus      As Long
Dim longwarnings    As Long
Dim swCustProp      As SldWorks.CustomPropertyManager
Dim Value           As String
Dim réponse         As Integer


Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

' Vérifie si un plan est ouvert'
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

swApp.SendMsgToUser ("Seulement à partir d'un plan !!")

Exit Sub

End If

'-------------------------------------------------- Récupération de l'indice

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.GetFirstView 'Active le fond de plan
Set swView = swView.GetNextView 'Active la première vue après le fond de plan
Set swModel = swView.ReferencedDocument 'Récupère le fichier associé à la première vue
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
swCustProp.Get3 "Indice en cours", False, "", Value 'Récupération de la propriété "Indice en cours"

'-------------------------------------------------- Préparation du 3D pour STEP

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

Set swModel = swApp.ActiveDoc
Set myModelView = swModel.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "", False, longstatus
Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 True
Set myModelView = swModel.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".step"

'--------------------------------------------------- Vérif avant écrasemant ou création'

If Len(Dir(Filepath & FileName)) = 0 Then

GoTo CréationEcrasement
Else
réponse = MsgBox("Ecraser l'existant", vbOKCancel + vbQuestion, "/!\ INDICE EXISTANT /!\")

If réponse = vbOK Then
GoTo CréationEcrasement
End If

If réponse = vbCancel Then
End If
Exit Sub

CréationEcrasement:

'-------------------------------------------------- Enregistrement du 3D en STEP

swModel.SaveAs3 Filepath & FileName & "", 0, 0

Set swModel = Nothing
swApp.CloseDoc ""
Set swModel = swApp.ActiveDoc


'-------------------------------------------------- Enregistrement du plan en PDF

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".pdf"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0


'-------------------------------------------------- Enregistrement du plan en DXF

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".dxf"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0

End If
End Sub


u code ici
2

Hallo

Versuchen Sie es so:


Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = swView.GetReferencedModelName
swApp.ActivateDoc2 FileName, False, longstatus
Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 True
Set myModelView = swModel.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".step"

Der Code ist optimierbar, es gibt nutzlose Funktionsaufrufe, die den Speicher überlasten können

1 „Gefällt mir“
3

Ja, wie @Cyril.f
Sie machen ein SetModel mehrmals, das ist ein Problem.
Mit diesem Code funktioniert es, aber es gibt wahrscheinlich noch ein bisschen Aufräumarbeit zu tun.
Die debug.print ermöglicht es Ihnen, den Namen des aktuellen Modells im Bearbeitungsfenster zu sehen. (Zum späteren Kommentieren oder Löschen)


Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swView          As SldWorks.View
Dim Filepath        As String
Dim FileName        As String
Dim boolstatus      As Boolean
Dim longstatus      As Long
Dim longwarnings    As Long
Dim swCustProp      As SldWorks.CustomPropertyManager
Dim Value           As String
Dim réponse         As Integer


Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

' Vérifie si un plan est ouvert'
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

swApp.SendMsgToUser ("Seulement à partir d'un plan !!")

Exit Sub

End If

'-------------------------------------------------- Récupération de l'indice

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.GetFirstView 'Active le fond de plan
Set swView = swView.GetNextView 'Active la première vue après le fond de plan
Set swModel = swView.ReferencedDocument 'Récupère le fichier associé à la première vue
Set swModelDocExt = swModel.Extension
 Debug.Print swModel.GetPathName & "  [" & swModel.Visible & "]"

Debug.Print "  " & swModel.GetTitle & " [" & swModel.GetType & "]"
Set swCustProp = swModelDocExt.CustomPropertyManager("")
swCustProp.Get3 "Indice en cours", False, "", Value 'Récupération de la propriété "Indice en cours"

'-------------------------------------------------- Préparation du 3D pour STEP

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
Debug.Print Filepath

'Set swModel = swApp.ActiveDoc
'Set myModelView = swModel.ActiveView
'myModelView.FrameState = swWindowState_e.swWindowMaximized
'swApp.ActivateDoc2 "", False, longstatus
'Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 True
'Set myModelView = swModel.ActiveView
'myModelView.FrameState = swWindowState_e.swWindowMaximized

FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".step"
Debug.Print FileName
'--------------------------------------------------- Vérif avant écrasemant ou création'

If Len(Dir(Filepath & FileName)) = 0 Then

GoTo CréationEcrasement
Else
réponse = MsgBox("Ecraser l'existant", vbOKCancel + vbQuestion, "/!\ INDICE EXISTANT /!\")

If réponse = vbOK Then
GoTo CréationEcrasement
End If

If réponse = vbCancel Then
End If
Exit Sub

CréationEcrasement:

'-------------------------------------------------- Enregistrement du 3D en STEP

swModel.SaveAs3 Filepath & FileName & "", 0, 0

Set swModel = Nothing
swApp.CloseDoc ""
Set swModel = swApp.ActiveDoc


'-------------------------------------------------- Enregistrement du plan en PDF

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".pdf"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0


'-------------------------------------------------- Enregistrement du plan en DXF

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".dxf"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0

End If
End Sub

Der Dateipfad wird 3-4 Mal mit dem gleichen Inhalt (also Wert) = nutzlos neu geschrieben.
Fügen Sie debug.print hinzu, um die Werte Ihrer Variablen anzuzeigen, während Sie Schritt ausführen, dies wird Ihnen sehr helfen.

1 „Gefällt mir“
4

Für mich ist es eher der Set-Swapp, der das Problem ist. Er lädt den SW-Prozess mehrmals in den Speicher

2 „Gefällt mir“
5

Richtig @Cyril f , ich hatte nicht gesehen, dass ich alle Zeilen außer der 1. mit Set swApp kommentieren konnte.
Das Set wird verwendet, um Ihre Variable zu initialisieren, so dass normalerweise 1 Set pro Variable ausreicht.

2 „Gefällt mir“
6

Vielen Dank, meine Herren,

Du bist oben. Es funktioniert wie die Hölle!!
Ich verstehe ein bisschen besser, was ich getan habe.

Die erste Lösung, die Cyril vorschlug, hatte mich entsperrt, aber jetzt kann man nicht einmal mehr das geöffnete 3D sehen. Perfekt!

7

Gut gemacht, es schien mir, dass das Öffnen der Datei für den Export notwendig/obligatorisch war. Da er aber beim Öffnen der Zeichnung mit Speicher geladen wird, kann darauf verzichtet werden.

1 „Gefällt mir“