PDF-DXF-STEP à partir d'un plan

Bonjour,
j’ai réussi à combiner des macros existantes que j’ai glané à droite et à gauche.
Grace à vous mon boulot s’en trouve grandement facilité.

J’ai réussi à faire cette macro avec une gestion d’indice qui évite d’écraser un indice existant mais je ne comprend pas pourquoi le .step ne marche pas pour un plan d’ensemble et ouvre la première pièce et en fait le .Step. Je pensais ouvrir le fichier de la première vue du plan.
Je tourne autour du problème sans le voir.

Il doit y avoir des petites erreurs ou incohérences dans tous ça, mais je sens que je touche du doigt la solution.

L’erreur est dans le paragraphe " préparation du 3D pour STEP"

Merci à ceux pour qui le VBA est une langue naturelle. Je vous admire ^^

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

Bonjour,

Plutôt essayer comme ça:


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"

Le code est optimisable il y a des appels de fonction inutiles voir qui peuvent surcharger la mémoire

1 « J'aime »

Oui même chose que @Cyril.f
Tu fait plusieurs fois un SetModel qui pose problème.
Avec ce code cela fonctionne, par contre il reste probablement un peu de nettoyage à faire.
Les debug.print permettent de voir le nom du modèle en cours dans la fenêtre d’édition. (A mettre en commentaire ou supprimer ensuite)


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

Filepath est réécrit 3-4 fois avec le même contenu (donc valeure)= inutile.
Ajoute des debug.print pour voir les valeurs de tes variable au fur et à mesure de l’exécution en pas à pas cela t’aidera grandement.

1 « J'aime »

Pour moi c’est plus les Set swapp qui posent problème. Ca charge en mémoire plusieurs fois le process SW

2 « J'aime »

Exact @Cyril.f , j’avais pas vu effectivement à mettre en commentaire toute les ligne sauf la 1ère avec Set swApp.
Le set sert à initialiser ta variable donc normalement 1 set par variable suffit.

2 « J'aime »

Merci Messieurs,

Vous êtes au top. ça marche au poil !!
Je comprends un peu mieux ce que j’ai fait.

la première solution proposée par Cyril m’avait débloqué mais là on ne voit même plus le 3D s’ouvrir. Parfait !

Bien vu, il me semblait que l’ouverture du fichier était nécessaire/obligatoire pour exporter. Mais comme il est chargé en mémoire à l’ouverture de la mise en plan on peut s’en affranchir.

1 « J'aime »