Faire une macro pour redimensionner les images d'esquisses

jviendu13 · Septembre 16, 2016, 11:38

Bonjour,

Pas encore fait de VBA, soif d'apprendre, connaissances de Matlab (= connaissances de tout ce qui est boucle...).

Objectif :

-J'ai plusieurs matériels (=1700 matériels) à déposer sur une plaque avec chacun sa photo (=1700 photos). J'ai donc prévu de faire des configurations avec des images d'esquisses.

Base de travail :

-J'ai rentré dans mon "matériels.SLDPRT" toutes les images et j'ai renommé les esquisses (de ces images d'esquisse).

-Après avoir vu pas mal de forum, je n'arrive toujours pas à voir un semblant de solution :'(.

Macro souhaitée :

-Aujourd'hui je voudrais redimensionner les images d'esquisses et créer une configuration pour chacune.

-Bien entendu 1700 fois à redimensionner une position X, une position Y, une largeur et une hauteur + la configuration à créer du nom de l'esquisse = des années xD.

-Il est impossible (sauf erreur) de selectionner toutes les images d'esquisse et de les modifier d'un coup et de plus les images d'esquisses ne sont pas soumis à l'aimantation..

Pourriez-vous m'aider à créer cette macro et/ou partager une autre solution,

Merci d'avance :D

Azrod · Septembre 16, 2016, 12:10

Bonjour,

c'est un gros truc ça.. bonne chance à celui qui y arrivera :)

J'imagine que toutes les photos n'ont pas les mêmes dimensions?

remrem · Septembre 16, 2016, 12:42

Salut,

Pour commencer le VBA :

http://didier-gonard.developpez.com/tutoriels/office/vba-qu-est-que-c-est/
http://heureuxoli.developpez.com/office/word/vba-all/

Ensuite pour insérer une image dans ton esquise tu dois utiliser la méthode InsertSketchPicture décrite ici : http://help.solidworks.com/2016/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.imodeldoc2~insertsketchpicture.html

Un exemple en VBA est disponible ici : http://help.solidworks.com/2016/english/api/sldworksapi/flip_sketch_picture_example_vb.htm

Décompose ton projet en plusieurs étapes : ouvrir la pièce, insérer une seule image, boucler les images...

Sinon il sera trop compliqué. Ensuite reviens vers nous...

jviendu13 · Septembre 16, 2016, 5:36

Bonjour génie, voici mon souhait :

Admettons que j'ai 2 images : KTT212.bmp et PPT213.bmp de même Taille : 90mmx75mm

Je voudrais : Créer 2 images d'esquisses sur mon "Plan à 4mm" avec Nom d'esquisse : KTT212 et PPT213 (pas le nom de "image d'esquisse")

Voici les Étapes à effectuer:

- Ouvrir ma pièce "E:\utilisateur\Documents\Matériels.sldprt"

- VariableNom1 = Nom "E:\utilisateur\Documents\KTT212.bmp" (= KTT212)

- Créer une esquisse

-> Sur "Plan à 4mm"

-> Nom esquisse = VariableNom1

Créer une configuration

-> Nom configuration = VariableNom1

- Créer une image d'esquisse via "E:\utilisateur\Documents\KTT212.bmp"

-> Dimension de l'image 60mm x 50mm

- Boucle sur VariableNom*

Merci de votre temps, voici mon challenge ;D

remrem · Septembre 19, 2016, 7:31

Salut @ jviendu13,

Je vais essayé d'être clair. Nous ne sommes pas là pour faire ton code à ta place et te le livrer fonctionnel.

On est tous ici pour s'aider mais pas pour faire ton travail.

Essaye de commencer par lire les tutoriels et autres aides et esquisser un bourt de code. Ensuite expose nous tes soucis ou problèmes et on t'aidera...

Apprendre à coder demande du temps et de l'implication. Si on te donne des choses toutes faites. Tu n'apprendra rien. S

Bonne journée.

jviendu13 · Septembre 19, 2016, 8:49

Alors ça, c'était facile.

Avant de m'attaquer au code comme tu le stipules, il vaut mieux demander si les étapes conviennent.

Et contrairement à ce que tu penses, j'en ai bouffé des tutos et autres forum pour me fournir en exemple. Et cela avant, après et encore maintenant. D'ailleurs la communauté autour du VBA a l'air d'être très accueillante envers les newbies xD.

Au passage j'y ai découvert qu'il faut que je liste mon dossier où se trouve les images et ainsi l'incrémentation d'une image à l'autre se fera toute seul. -> Ce que tu sais surement. Je ne suis pas là pour demander un code mais plutot les commandes vis à vis de Solidworks.

Enfin bref, comme je l'ai dit, je prends ça tout juste en main, essai de ne pas casser mon enthousiasme stp.

Mes soucis :

-Incrémentation sur 50 images d'un dossier : résolu = il faut lister le dossier

Commande Dir il me semble, reste à apprendre à l'utiliser de mon côté

-Accéder aux propriétés d'une image d'esquisse : En recherche (Hauteur, Largeur, Horizontale, Verticale)

Cette commande ci-dessous n'a pas l'air de marcher ou plus probable que je n'arrive pas à l'utiliser correctement

   swSketchPicture.GetSize width, height
    Debug.Print " Width: " & width * 1000 & " mm"
    Debug.Print " Height: " & height * 1000 & " mm"

-Récupérer le nom de l'image que j'insère et l'utiliser pour renommer l'esquisse + configuration : En recherche

Remarque Utile : Les tutos sont pour excel, et l'aide Solidworks ne montre pas les "commandes", du coup pour trouver ce que je cherche c'est un vrai casse tête.

jviendu13 · Septembre 19, 2016, 8:50

Et voici Mon bout de code avec lequel j'essai d'avancer :

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _
Application.SldWorks

'Ouvrir Pièce
Set Part = swApp.OpenDoc6("C:\Users\ad36aaen\Documents\Utilisat\Conception SdC\1300\Structures de base\Structures\Matériels\Matériels.SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 "Matériels.SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

'Boucle for i=1 to 50(=NbrFic)... enf if
'Plan

boolstatus = Part.Extension.SelectByID2("Plan 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
'Image d'equisse
Part.SketchManager.InsertSketch True
Dim SkPicture As Object

'Il faut lister, pas insérer : commande Dir

'Il faut récupérer le nom de l'image dés qu'on l'insère
Set SkPicture = Part.SketchManager.InsertSketchPicture("C:\Users\ad36aaen\Documents\Utilisat\Conception SdC\1300\Structures de base\Structures\Matériels\Photos matériels\P01\HO\TPL_REA390TL.png")
Part.ClearSelection2 True
Part.SketchManager.InsertSketch True
boolstatus = Part.Extension.SelectByID2("Esquisse220", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Esquisse220", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

'Nom esquisse
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "1")
boolstatus = Part.Extension.SelectByID2("Image d'esquisse1577", "SKETCHBITMAP", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Image d'esquisse1577", "SKETCHBITMAP", 0, 0, 0, False, 0, Nothing, 0)

'Nom image d'esquisse
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "2")
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

'Dossier
Dim myFeature As Object
Set myFeature = Part.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_Containing)
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "3")
'Configuration
boolstatus = Part.Extension.SelectByID2("Défaut", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("4", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("4", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)

'Nom configuration
boolstatus = Part.SelectedFeatureProperties(15651274, 1, 1, 0.5, 0.400000005960464, 0, 0, 0, 0, "5")
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("2", "SKETCHBITMAP", 2.22464985227471E-02, 4.0000000000191E-03, -5.56639089934266E-02, False, 0, Nothing, 0)
Part.ClearSelection2 True
End Sub

remrem · Septembre 19, 2016, 11:39

Bon, avec ton code et tes explications cela est déjà bien plus simple et montre le travail déjà réalisé.

Pour ta question :

-Accéder aux propriétés d'une image d'esquisse : En recherche (Hauteur, Largeur, Horizontale, Verticale)

Cette commande ci-dessous n'a pas l'air de marcher ou plus probable que je n'arrive pas à l'utiliser correctement

   swSketchPicture.GetSize width, height
    Debug.Print " Width: " & width * 1000 & " mm"
    Debug.Print " Height: " & height * 1000 & " mm"

Le debug.print ne sert qu'a connaitre les valeurs pour du debuggage mais pas à les modifier.

jviendu13 · Septembre 19, 2016, 11:47

Oui j'ai vu ma bêtise, c'est juste un afficheur de valeur xD, comme un "plot". Du coup je pars sur du "setsize".

Je pensais arriver à avoir ce que je voulais avec le code ci-dessous, mais non. Le code ne fait que m'ajouter l'image d'esquisse sans modifier les dimension = Tristesse :'(

-> Résolu = Joie :D

SkPicture.SetSize Width, Height, AspectRatioLocked <- Faut mettre les valeurs là --'
Width = 50/1000
Height = 60/1000 PAS LA xD
AspectRatioLocked = False

Maintenant que j'ai réussi à redimensionner, il faut que je m'attaque au renommage et à la boucle xD.

Donc le but est de

-Faire un Dir + boucle pour lister toutes mes images d'un dossier

Question : J'ai vu qu'il est possible de lister que les *.ini, *bmp, mais est-il possible de prendre en compte que le début ? genre KT* ?

-A chaque fois récupérer le nom de l'image qu'on traite : Là je recherche la "commande" qui appelle le nom de l'image que je viens d'insérer. Tout comme je cherchais la commande setsize ;D.

C'eest trop bien le VBA quand le code marche \o/

remrem · Septembre 19, 2016, 12:19

C'est exactement ce que j'ai pu constater également de mon coté.

Si je cherche dans l'aide SW elle ne contient rien ! La première fois que je rencontre ceci.

J'ai donc utilisé un moyen détourné :

Voici comment changer la taille :

Tu dois utiliser la méthode setsize.

En paramètre largeur puis hauteur et enfin true ou false pour bloquer le ratio hauteur/ largeur

jviendu13 · Septembre 19, 2016, 12:37

Haha ^^,

Oui ça a marché, j'avais trouvé juste avant, et j'ai trouvé aussi pourquoi mon code ne changer rien. Mettre les valeurs aux bonnes endroits ça aide beaucoup xD.

Là je cherche à renommer avec le nom de l'image :

- Je recherche la commande permettant de récupérer le nom de la dernière image insérer/utiliser/qui est là sous mes yeux xD

- Pour la boucle : C'est bien la commande Dir pour ajouter toutes les images d'un dossier une à une dans une boucle?

Question : J'ai vu qu'il est possible de lister que les *.ini, *bmp, mais est-il possible de prendre en compte que le début ? genre KT* ?

Merci encore de ton temps ^^

remrem · Septembre 19, 2016, 12:52

Pour le nom essaye ceci : ;-)

swSketchPicture.GetFeature.SetImportedFileName ("Nom")

En ce ui concerne la liste des fichiers par extension.

Je reviens un peu plus tard...

jviendu13 · Septembre 19, 2016, 1:04

Pour la boucle j'ai tenté ce code, mais ça fait crash solidworks :'(

MonImage = Dir("C:\Users\ad36aaen\Documents\P01\HO\")

For i = 1 To 3

..

Set SkPicture = Part.SketchManager.InsertSketchPicture(MonImage)

..

MonImage = Dir
Next i

remrem · Septembre 19, 2016, 3:42

Je joins un fichier macro qui liste les fichiers d'un répertoire dont le nom commence par KT.

Je pense qu'il faudrait faire des tests pour vérifier qu'il sagit d'une image en utilisant la méthode : oFl.Type

macro1.swp

jviendu13 · Septembre 19, 2016, 4:07

Super, Merci.

remrem · Septembre 20, 2016, 6:24

Salut,

J'ai oublier : Il faut rajouter au projet la référence Microsoft Scripting Runtime dans Outils / Références

Bonnee journée.

jviendu13 · Septembre 20, 2016, 8:36

Ca avance bien,

-Redimensionner ok,

-Boucle ok,

-Le nom presque ok :

Si je ne laisse pas le point à la fn, Nom_EsquisseAP n'est pas pris en compte, ça marche que s'il y a le point...

Je suis en train de voir pour les configurations dérivées xD

Mon code :

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim SkPicture As Object
Dim instance As ISketchPicture
Dim Width As Double
Dim Height As Double
Dim AspectRatioLocked As Boolean
Dim value As Boolean
Dim X As Double
Dim Y As Double
Dim Système As Object           'Système de fichiers
Dim Dossier As Object           'Répertoire
Dim Fichiers As Object          'Collection de fichiers du répertoire
Dim Fichier As Object           'Fichier (élément de la collection Fichiers)
Dim Nom_Dossier As String       'Nom du répertoire
Dim Nom_Fichier As String       'Nom du fichier
Dim Nom_EsquisseAV As String      'Nom d'esquisse avant
Dim Nom_EsquisseAP As String      'Nom d'esquisse après
Dim k As Integer

Sub main()

Set swApp = _
Application.SldWorks

Set Part = swApp.OpenDoc6("C:\Users\ad36aaen\Documents\Utilisat\Conception SdC\1300\Structures de base\Structures\Matériels\Matériels.SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 "Matériels.SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc

k = 1

'Lecture du répertoire
Nom_Dossier = "C:\Users\ad36aaen\Documents\Utilisat\Conception SdC\1300\Structures de base\Structures\Matériels\Photos matériels\P01\HO\Test"
Set Système = CreateObject("Scripting.FileSystemObject")
Set Dossier = Système.GetFolder(Nom_Dossier)
Set Fichiers = Dossier.Files

'Boucle
For Each Fichier In Fichiers
    'Créer noms
    Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
    Nom_EsquisseAV = "Esquisse" & k
    Nom_EsquisseAP = Left(Fichier.Name, Len(Fichier.Name) - 3)

    'Sélection Plan
    boolstatus = Part.Extension.SelectByID2("Plan à 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

    'Créer image d'esquisse
    Part.SketchManager.InsertSketch True
    Set SkPicture = Part.SketchManager.InsertSketchPicture(Nom_Fichier)

    'Redimensionner
    SkPicture.SetSize 50 / 1000, 60 / 1000, False
    SkPicture.SetOrigin -25 / 1000, -20 / 1000

    Part.ClearSelection2 True

    'Selectionner Esquisse + modifier nom
    boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAV, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
    boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, Nom_EsquisseAP)

    'État supprimer d'esquisse => allègera quand on sera à la 1000ème esquisse
    boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAP, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
    Part.EditSuppress2

    Part.ClearSelection2 True

k = k + 1

Next Fichier
End Sub

jviendu13 · Septembre 20, 2016, 8:52

Ca y est j'ai fini,

Malgrès ce problème de point juste après le nomp, tout marche \o/

Code pour des gens qui voudrait voir/avoir :

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim SkPicture As Object
Dim instance As ISketchPicture
Dim Width As Double
Dim Height As Double
Dim AspectRatioLocked As Boolean
Dim value As Boolean
Dim X As Double
Dim Y As Double
Dim Système As Object           'Système de fichiers
Dim Dossier As Object           'Répertoire
Dim Fichiers As Object          'Collection de fichiers du répertoire
Dim Fichier As Object           'Fichier (élément de la collection Fichiers)
Dim Nom_Dossier As String       'Nom du répertoire
Dim Nom_Fichier As String       'Nom du fichier
Dim Nom_EsquisseAV As String      'Nom d'esquisse avant
Dim Nom_EsquisseAP As String      'Nom d'esquisse après

Sub main()

Set swApp = _
Application.SldWorks

Set Part = swApp.OpenDoc6("C:\Users\Matériels\Matériels.SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 "Matériels.SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc

k = 2

'Lecture du répertoire
Nom_Dossier = "C:\Users\Matériels\Photos matériels\P01\HO\Test"
Set Système = CreateObject("Scripting.FileSystemObject")
Set Dossier = Système.GetFolder(Nom_Dossier)
Set Fichiers = Dossier.Files

'Contrôler chaque fichier du répertoire
For Each Fichier In Fichiers
    'créer image d'esquisse et mettre à jour les dimensions
    Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
    Nom_EsquisseAP = Left(Fichier.Name, Len(Fichier.Name) - 3)

    boolstatus = Part.Extension.SelectByID2("Plan à 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

    Part.SketchManager.InsertSketch True
    Set SkPicture = Part.SketchManager.InsertSketchPicture(Nom_Fichier)

    SkPicture.SetSize 50 / 1000, 60 / 1000, False
    SkPicture.SetOrigin -25 / 1000, -20 / 1000

    Part.ClearSelection2 True

    boolstatus = Part.Extension.SelectByID2("Esquisse1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
    boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, Nom_EsquisseAP)

    boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAP, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
    Part.EditSuppress2

    boolstatus = Part.Extension.SelectByID2("AM_P01_HO", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
    boolstatus = Part.AddConfiguration2("AM_" & Nom_EsquisseAP, "", "", False, False, False, True, 256)

    Part.ClearSelection2 True

Next Fichier
End Sub

remrem · Septembre 20, 2016, 9:02

Je ne comprend pas pour quoi il ya deux fois Set Part au début. Pour moi tu ouvres la pièce et tu renseigne donc la variable Part. Puis tu lui dit que la variable Part estégale au fichier actif.

Pour le nom je ne comprend pas le souci. Tu dois laisser le point où ?

remrem · Septembre 20, 2016, 9:20

J'ai fait un peu de ménage. ;-)

Attention il faut utiliser avec prudence les déclarations de variable Object.

En gros cela convient à dire au programme je ne sais ce que cela va être cela peut aller du boulon à l'éléphant à toi de gérer...

Essaye ceci : A TESTER

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim SkPicture As Object
Dim Système As Scripting.FileSystemObject       'Système de fichiers
Dim Dossier As Folder                           'Répertoire
Dim Fichier As File                              'Fichier (élément de la collection Fichiers)
Dim Nom_Dossier As String                      'Nom du répertoire
Dim Nom_Fichier As String                      'Nom du fichier
Dim Nom_EsquisseAV As String                     'Nom d'esquisse avant
Dim Nom_EsquisseAP As String                     'Nom d'esquisse après

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.OpenDoc6("C:\Users\Matériels\Matériels.SLDPRT", 1, 0, "", longstatus, longwarnings)

   'Lecture du répertoire
   Nom_Dossier = "C:\Users\Matériels\Photos matériels\P01\HO\Test"
   Set Système = CreateObject("Scripting.FileSystemObject")
   Set Dossier = Système.GetFolder(Nom_Dossier)

   'Contrôler chaque fichier du répertoire
   k = 2
   For Each Fichier In Folder.Files
       'créer image d'esquisse et mettre à jour les dimensions
       Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
       Nom_EsquisseAP = Left(Fichier.Name, Len(Fichier.Name) - 3)

       boolstatus = Part.Extension.SelectByID2("Plan à 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

       Part.SketchManager.InsertSketch True
       Set SkPicture = Part.SketchManager.InsertSketchPicture(Nom_Fichier)

       SkPicture.SetSize 50 / 1000, 60 / 1000, False
       SkPicture.SetOrigin -25 / 1000, -20 / 1000

       Part.ClearSelection2 True

       boolstatus = Part.Extension.SelectByID2("Esquisse1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
       boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, Nom_EsquisseAP)

       boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAP, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
       Part.EditSuppress2

       boolstatus = Part.Extension.SelectByID2("AM_P01_HO", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
       boolstatus = Part.AddConfiguration2("AM_" & Nom_EsquisseAP, "", "", False, False, False, True, 256)

       Part.ClearSelection2 True

   Next Fichier
End Sub