Améliorer Macro X_T pour créer un dossier si inexistant sur Solidworks?

Macro
1

J'ai déjà une macro (que je met en pièce jointe) qui me permet d'exporter une pièce ou un assemblage en X_T dans un sous dossier "FICHIERS X_T".

J'aurais besoin que quand le dossier "FICHIERS X_T" n'existe pas, ça puisse en créer un pour insérer le fichier exporté dedans, comment faut-il programmer cela ?

Le programme actuel :

 

Sub Sauvegarde_X_T()


Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Locatie As String
Dim Locatie_aangepast As String
Dim OpenDoc As Object
Dim Extensie_nieuw As String
Dim Extensie_oud As String
Dim retval As String
Dim Naam As String
Dim Naam_aangepast As String

 

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set OpenDoc = swApp.ActiveDoc()

Extensie_oud = ".SLDASM"
Extensie_nieuw = ".X_T"
Locatie = OpenDoc.GetPathName
Locatie_aangepast = Left(Locatie, Len(Locatie) - 7)
retval = Dir$(Locatie_aangepast & Extensie_oud)
Naam = Dir$(Locatie)
Naam_aangepast = Left(Naam, Len(Naam) - 7)
Titel = OpenDoc.GetTitle
Titel = Left(Titel, (Len(Titel)))


    
Set Part = swApp.ActiveDoc

Dim FilePath As String, FileName As String

FilePath = Left(Locatie, InStrRev(Locatie, "\"))
MsgBox FilePath & "FICHIERS X_T\" & Naam_aangepast & Extensie_nieuw
longstatus = Part.SaveAs3(FilePath & "FICHIERS X_T\" & Naam_aangepast & Extensie_nieuw, 0, 0)

End Sub


save_x_t_-_fichiers_x_t.zip
2

voir cette page

http://www.beta.lynkoa.com/forum/3d/macro-enregistrement-en-pdf-dans-un-dossier-specifique

une macro @ jfaradon qui est en theori quelqu'un qui sait de quoi il parle
 
peut etre un debut d'orientation de bout de code
 
@+ ;-))
 
 
 
3

Salut, il faut ajouter après cette ligne :

FilePath = Left(Locatie, InStrRev(Locatie, "\"))

If dir$(FilePath) ="" then

Mkdir FilePath

End if

4

@ PL il suffit d'ajouter quoi puisque tu dis il suffit ajouter apres cette ligne mais il ni a rien

@+

1 « J'aime »
5
Oui GT désolé la réponse est partie trop vite, j'ai édité après.
1 « J'aime »
6

et oui @ PL le probleme est la

la reedition des reponses sans aucune ref de reedition

et pourtant x fois demande a notre CM

il faut dans la mesure du possible eviter de reediter une reponse

quite a remettre une reponse

@+ ;-))

7

@ PL quand on regarde le fil de comm des reponses

ta reponse reedite garde le meme time

donc vis a vis du time ma reponse est parvenu apres et pourtant ce n'est pas le cas

donc incomprehension de la lecture des reponses sur ce fil de comm

la notion de reedition devrait etre notifier pour une plus grande clarete du fil de comm

et c'est souvent le cas

qui de + est souvent on reponds a une question sans reponse de prime abord

et quand on la publie on est toujours le premier a la publication

mais si on fait un refresh on s'appercois qu'il n'en est rien et qu'une personne a deja repondu

le malaise est la le plus souvent

@+ ;-))

 

@+ ;-))

8

Ca ne fonctionne pas ...

Ca créé pas de dossier si il n'existe pas.

9
Essaye avec dir$ à la place de dir
10

je comprend pas trop ...

Je ne dois pas ajouter des choses entre les "" ?

Du genre le nom du dossier que ça doit créer ? Parce que je ne comprend pas comment le programme va créer le dossier avec le nom qu'il faut ?

 

If dir$(FilePath) ="" then

Mkdir FilePath

End if

11

Salut,

La fonction MkDir n'accepte pas de créer un autre réportoire sur un autre lecteur que celui sur lequel est exécuté la macro.

12

Lui préferer la méthode : My.Computer.FileSystem.CreateDirectory

Lus d'infos ici : https://msdn.microsoft.com/fr-fr/library/2wwkaadb%28v=vs.90%29.aspx

13

Et ça à la place, ça fonctionne ?

If Dir$(FILEPATH, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & FILEPATH & """")
End If

14

Ca ne fonctionne pas non plus. je crois que je vais abandonner l'idée.

Si jamais quelqu'un à une autre suggestion, je suis toujours prenneur.

Merci quand même à ceux qui ont pris le temps de chercher.

15

Je viens de tester cela avec succès :

Sub main()
   
Dim swApp As Object, Part As Object, OpenDoc As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Locatie As String, Locatie_aangepast As String, Extensie_nieuw As String, Extensie_oud As String, retval As String
Dim Naam As String, Naam_aangepast As String, FilePath As String, FileName As String, FolderPath As String

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set OpenDoc = swApp.ActiveDoc()

Extensie_oud = ".SLDASM"
Extensie_nieuw = ".X_T"
Locatie = OpenDoc.GetPathName
Locatie_aangepast = Left(Locatie, Len(Locatie) - 7)
retval = Dir$(Locatie_aangepast & Extensie_oud)
Naam = Dir$(Locatie)
Naam_aangepast = Left(Naam, Len(Naam) - 7)
Titel = OpenDoc.GetTitle
Titel = Left(Titel, (Len(Titel)))
    
Set Part = swApp.ActiveDoc

FilePath = Left(Locatie, InStrRev(Locatie, "\"))
FolderPath = FilePath & "FICHIERS X_T"

If Dir(FilePath, vbDirectory + vbHidden) <> "" Then
        If Dir(FolderPath, vbDirectory + vbHidden) = "" Then _
            MkDir FolderPath
End If

longstatus = Part.SaveAs3(FilePath & "FICHIERS X_T\" & Naam_aangepast & Extensie_nieuw, 0, 0)

End Sub

 

Le bout de code provient de : http://excel.developpez.com/faq/?page=FichiersDir#MkDir

Le forum www.developpez.com est un très bon forum où l'on trouve de très nombreuses infos et des participants sérieux. Je conseil fortement.


sauvegarder_xt.swp
16

Je viens de tester la macro que tu as mis, moi ça bug et ça me met ça :


sans_titre.jpg
17

Il n'y a aucune raison que ça ne fonctionne pas ! Quelles sont les erreurs lorsque tu as testé mon code ?

Et dans le dernier exemple, on dirait que tu n'as pas de fichier ouvert dans SolidWorks.

 

1 « J'aime »
18

Tu as une pièce ouverte ?

19

C'est bon j'ai résolue le problème, j'ai trouvé sur un forum :

"il s'agit en fait d'une erreur assez répandue, mais qui est liée à une référence manquante dans le projet VBA (cela arrive si les versions boulot/maison sont différentes ou absentes)

Outils>Références dans l'éditeur VBE décocher les références manquantes et/ou les remplacer par les versions disponibles."

 

Ducou ça fonctionne !!!!!!!!!!!!!!

Merci les gars !

1 « J'aime »