Créer des fichiers numérotés Résolu

Question

Bonjour @tous,

J'espère avoir correctement choisi le Thème.

Voilà comme dit dans mon profil, je suis Concepteur de Produits en 3D via le logiciel SolidWorks.
Il arrive parfois que dans certaines de mes missions clients je rencontre des fonctions spéciales.
Dans ce cas un précédent dessinateur avait crée une macro pour enregistrer le fichier automatiquement avec des numéros pour éviter que les fichiers suivant ne prennent un numéro existant,
Bonne intention, cependant étant pûriste dans l'organisation du modèle 3D, le fait d'avoir des numéros ainsi créer n'est pas des plus propre.

Je suis persuadé que l'on doit pouvoir commencer à 1 et enchainer au fil de la construction du projet.
Je vous colle donc le code en espérant que certains auront aisément la solution.

Merci @vous

Code de la fonction NewTube

Public swApp As Object
Public swpart As Object
Public Nom_Doc As String
Public Ext_Doc As String
Public Val_Prop As String
Public part As Object
Public boolstatus As Boolean
Public FeatureData As Object
Public Feature As Object
Public Component As Object
Public entete As Integer
Public miseajour
Public propriété, val_propriété, retval As Variant
Public longstatus As Long, longwarnings As Long

Sub NewTube2011()

Dim swApp  As SldWorks.SldWorks
Dim swpart As Object
Set swApp = Application.SldWorks
Set swpart = swApp.ActiveDoc
Dim componentDoc As Object
Dim swSelMgr                    As SldWorks.SelectionMgr
Dim swConfigMgr                 As SldWorks.ConfigurationManager
Dim swComp                      As SldWorks.Component2

Set swModel = swApp.ActiveDoc

Set swSelMgr = swModel.SelectionManager

Set swComp = swSelMgr.GetSelectedObjectsComponent2(1)

Set componentDoc = swComp.GetModelDoc

FichierActif = componentDoc.GetTitle


'""""""""""""" CALCUL DU NOUVEAU NOM """""""""""""""""""""""""

Dim MyTime, MySecond
index = Second(Now)


MyFolder = Strings.Left(swModel.GetPathName, Strings.InStrRev(swModel.GetPathName, "") - 1) + ""

FileName = Strings.Mid(swModel.GetTitle, 1, 11) + " - "

FileName = MyFolder & FileName & FichierActif & " - " & index & ".sldprt"



'""""""""""""" ENREGISTREMENT DU FICHIER SELECTIONNE """""""""""""""""""


componentDoc.SaveAs2 FileName, 0, False, False



End Sub

Utilisateur anonyme · Accepted Answer

Il suffit de passer un paramètre supplémentaire à la fonction:


Function GetLastIndex(ByVal directory As String, ByVal Title As String)
  Const EXT_SLDPRT As String = ".sldprt"
  Dim file As String
  Dim indexPos As Long
  Dim index As Long
  Dim maxIndex As Long

  If Not VBA.Right$(directory, 1) "" Then directory directory & ""


  maxIndex = 0

  file = Dir(directory & Title & " -*" & EXT_SLDPRT, VbFileAttribute.vbNormal)
  While Not file = vbNullString
    indexPos = VBA.InStrRev(file, "-")
    If indexPos > 0 Then
      index = Int(Val(VBA.Trim$(VBA.Mid$(file, indexPos + 1, Len(file) - indexPos - Len(EXT_SLDPRT)))))
      If index > maxIndex Then maxIndex = index
    End If
    file = Dir()
  Wend

  GetLastIndex = maxIndex
End Function


Où title est ton "A", "B" ...

_____________
Kenji

castromanuel · Answer

Charles ....

Comment dire ... TROP TOP !!!

pour l'instant çà marche NIKEL,
j'ai crée d'abord un dossier  .... enfin une petite arborescence ,
puis j'ai crée 2 tubes dans une "ligne" puis j'ai refermé le logiciel,
j'ai ouvert à nouveau le logiciel puis repris la conception de la "ligne" et y ait ajouté un nouveau tube !

le résultat s'est pour l'instant enchainé comme je l'avais imaginé
XXXX - Tube ISO - 1 et XXXX - Tube ISO - 2
puis imaginons le lendemain XXXX - Tube ISO - 3

je vais poursuivre les essais avec ce nouveau code.

Je souhaiterais garder ou avoir tes coordonnées de sorte à éventuellement apprendre un peu ce langage.

Je te tiens au courant la semaine prochaine du résultat lors du travail des autres dessinateurs sur des stations d'épuration plus lourde que juste mon petit fichier à 3tubes.

MERCI ! ENCORE !

castromanuel · Answer

ucfoutu,

ta proposition de passer par STATIC, m'a été faite sur un autre forum,
mais la personne ayant proposé cette solution a aussi ajouté qu'elle a un coté négatif, c'est qu'elle se met à zéro à chaque nouveau démarrage du logiciel, et qu'elle fonctionnerait sans doute correctement par rapport à mes attentes , à savoir ne pas écraser les précédents tubes, en utilisant conjointement soit DIR() soit une liste de fichiers.

@suivre

Utilisateur anonyme · Answer

Mais de rien 
Garde les coordonnées de ce forum, je ne suis pas toujours disponible et d'autres développeurs peuvent aussi d'aider.
Essaye d'être plus précis pour tes future demandes 

_____________
Kenji

castromanuel · Answer

Charles,

en espérant que tu vois l'image, je viens de tenter la modification d'un ancien fichier et donc d'une ancienne ligne de tuyauterie



il apparait un soucis , la macro n'arrive pas créer le nom de fichier et de fait le fichier.
il remonte un soucis sur le programme , souligner en jaune dans la partie gauche de l'image.

@suivre

Utilisateur anonyme · Answer

Je vois bien l'image ^^
Par contre, il dois t'indique aussi un message d'erreur qui me serait fort utile.
Ajoute aussi un "Debug.Print file" juste avant la lige en jaune et affiche la fenêtre de Debug (Ctrl-G) ou menu Affichage > "Immediate Window" (je n'ai pas de version FR donc je connais pas la traduction)


_____________
Kenji

castromanuel · Answer

la fenetre s'ouvre et dit

Erreur d'exécution '6':

Dépassement de capacité

l'original >


pardon j'y avais pensé et suis parti dans d'autres trucs ...

@suivre

Utilisateur anonyme · Answer

Est-ce possible d'avoir le nom du fichier sur lequel il bloque ?
Les noms s'affichent dans la fenêtres de Debug si tu as bien ajouté la ligne que je t'avais demandé.

_____________
Kenji

castromanuel · Answer

sur l'image Macro NewTube_noms fichiers 1

tu vois dans la partie droite en haut le nom de l'assemblage dans lequel la ligne de tube est construite et ajoutée.

pour ce qui est du code j'ai fait les modifs que tu as préconisés

et sur l'image Macro NewTube_noms fichiers 2
c'est la fenetre Microsoft Visual Basic tel qu'elle s'est ouverte

je te remets la fin du nouveau code 

'""""""""""""" CALCUL DU NOUVEAU NOM """""""""""""""""""""""""

Dim MyTime, MySecond
index = Second(Now)


MyFolder = Strings.Left(swModel.GetPathName, Strings.InStrRev(swModel.GetPathName, "") - 1) + ""

index = GetLastIndex(MyFolder) + 1

FileName = Strings.Mid(swModel.GetTitle, 1, 11) + " - "

FileName = MyFolder & FileName & FichierActif & " - " & index & ".sldprt"



'""""""""""""" ENREGISTREMENT DU FICHIER SELECTIONNE """""""""""""""""""


componentDoc.SaveAs2 FileName, 0, False, False



End Sub

Function GetLastIndex(ByVal directory As String)
  Const EXT_SLDPRT As String = ".sldprt"
  Dim file As String
  Dim indexPos As Long
  Dim index As Long
  Dim maxIndex As Long

  If Not VBA.Right$(directory, 1) "" Then directory directory & ""


  maxIndex = 0

  file = Dir(directory & "*" & EXT_SLDPRT, VbFileAttribute.vbNormal)
  While Not file = vbNullString
    indexPos = VBA.InStrRev(file, "-")
    If indexPos > 0 Then
      index = Int(Val(VBA.Trim$(VBA.Mid$(file, indexPos + 1, Len(file) - indexPos - Len(EXT_SLDPRT)))))
      If index > maxIndex Then maxIndex = index
    End If
    file = Dir()
  Wend

  GetLastIndex = maxIndex
End Function


je viens de voir que malgré la présence de Second(Now) , lors de l'essai sur un assemblage tout neuf il était bien parti de 1 ...
Bon c'est étonnant ... mais tu auras sans doute une explication ... rationnelle à cela.

@suivre

castromanuel · Answer

Charles,

en supprimant les lignes
Dim MyTime, MySecond 
index = Second(Now)

il en ressort le meme comportement sur le modele de la photo

@suivre

Utilisateur anonyme · Answer

Ce qui me donne toujours pas le nom du fichier. Tu n'as pas rajouté le "Debug.Print file".
La seule façon pour que j'ai réussit à produire l'erreur et de mettre un numéro énormément grand.

Sinon, c'est normal, qu'il reprenne à 1, la fonction renvoie 0 s'il n'y a aucuns fichier numéroté.
Tu peux d'ailleurs retirer le "index = Second(Now)" qui ne sert plus ici.


_____________
Kenji

castromanuel · Answer

Charles,

et sans ces lignes,
le fichier démarré vierge continu de fonctionné correctement et les tubes de s'incrémenter au fur et a mesure de leur création.

@suivre

castromanuel · Answer

Charles,

d'où je sors de Debug.Print file


je pensais que le nom de fichier visible sur la photo était ta réponse

@suivre

castromanuel · Answer

si le Debug.Print file,

est la fenetre d'erreur, idem je te l'ai mise en lien .... image 

@suivre

castromanuel · Answer

Suite des essais,

dans un meme dossier, on peut avoir plusieurs lignes de tubes A, B,C ... en simplifiant
ce qui donne lors de leur construction
A - Tube DIN - 1 
A - Tube DIN - 2
A - Tube DIN - 3

actuellement le code construit B ainsi (le type de tube n'est que pour exemple il aurait pu être Tube DIN aussi)
B - Tube SMS - 4
B - Tube SMS - 5

hors on aurait souhaiter
B - Tube SMS - 1
B - Tube SMS - 2

@suivre

Utilisateur anonyme · Answer

Bonjour,

Je n'ai pas tout relu et je n'ai pas les images. Mais, c'est à toi de déterminer les raisons qui vont faire que ta numérotation doit repartir à zéro ou continuer. Cela personne ne peut le faire à ta place. Une fois que tu connais les raisons, il te reste deux possibilités : les raisons peuvent être déterminés automatiquement et être programmées, ou bien elles ne peuvent pas être programmées.

Si elles peuvent être programmées, il va falloir agir en conséquence. Sinon, tu mets une inputBox qui demande le numéro d'origine à utiliser.

castromanuel · Answer

Bonjour Marcotte,

si j'avais une petite maitrise de la programmation,
je n'aurai pas fait appel à un forum d'aide ...

mais la suggestion de l'inputbox est intéressante !

bonne journée.

castromanuel · Answer

Charles,

je teste le code sur le modèle de ligne vierge commencé et sur une ligne toute vierge, car je me dis que les lignes des projets en cours je leur laisserai l'ancienne macro.

cette modification renvoi un message d'erreur >

Erreur de compilation:
Argument non facultatif

et il pointe sur >

GetLastIndex

à la ligne >

index = GetLastIndex(MyFolder) + 1

@suivre

castromanuel · Answer

Charles,

erreur identique que le modèle violet d'hier avec le nom de ligne très long

@suivre

castromanuel · Answer

Charles,

Bon je peux dire que l'on ait arrivé au bout du code !
Il fonctionne sur les nouvelles lignes ...
mais aussi sur les anciennes !!

Je te remercie de ton implication.

Salutations sincères.

je met le sujet en résolu .... pour l'instant,
bien que je ne vois pas le bouton en question

castromanuel · Answer

Charles,

j'aurais aimé comprendre le code, complètement,
certaines fonctions (je les appelle comme çà) je les trouve expliqué sur http://msdn.microsoft.com
par contre d'autres pas du tout ...

quand je lis la ligne If Not VBA.r....
je comprends que tu forces le langage en VBA pour que la fonction string (étant traduit par $ sur des sites de cours) right fonctionne ...

y aurai t il un site qui regroupe l'ensemble ... des éléments ... que tu as utilisé pour la composition du code ...
ou bien est ce qu'il faut multiplier les sources comme d'habitude pour obtenir une information complète.

MERCI.

Créer des fichiers numérotés

41 réponses

Votre réponse

Discussions similaires