J'ai une macro qui permet de déplacer les composants sélectionnés d'un assemblage dans un dossier.
'**********************
'Copyright(C) 2019 www.codestack.net
'Reference: https://www.codestack.net/solidworks-api/document/assembly/components/move-to-folder/
'License: https://www.codestack.net/LICENSE.md
'**********************
#If VBA7 Then
Private Declare PtrSafe Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#Else
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
SelectComponentsFromCurrentSelection swModel
AddSelectedComponentsToNewFolder ""
Else
MsgBox "Please open assembly"
End If
End Sub
Sub SelectComponentsFromCurrentSelection(model As SldWorks.ModelDoc2)
Dim swComps() As SldWorks.Component2
Dim isArrInit As Boolean
isArrInit = False
Dim i As Integer
Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = model.SelectionManager
For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
Dim swComp As SldWorks.Component2
Set swComp = swSelMgr.GetSelectedObjectsComponent4(i, -1)
If Not swComp Is Nothing Then
Dim unique As Boolean
unique = False
If False = isArrInit Then
isArrInit = True
ReDim swComps(0)
unique = True
Else
unique = Not Contains(swComps, swComp)
If True = unique Then
ReDim Preserve swComps(UBound(swComps) + 1)
End If
End If
If True = unique Then
Set swComps(UBound(swComps)) = swComp
End If
End If
Next
If True = isArrInit Then
If UBound(swComps) + 1 <> model.Extension.MultiSelect2(swComps, False, Nothing) Then
Err.Raise vbError, , "Failed to select components"
End If
End If
End Sub
Function Contains(vArr As Variant, item As Object) As Boolean
Dim i As Integer
For i = 0 To UBound(vArr)
If vArr(i) Is item Then
Contains = True
Exit Function
End If
Next
Contains = False
End Function
Sub AddSelectedComponentsToNewFolder(dummy)
Const WM_COMMAND As Long = &H111
Const CMD_ADD_TO_NEW_FOLDER As Long = 37922
Dim swFrame As SldWorks.Frame
Set swFrame = swApp.Frame
SendMessage swFrame.GetHWnd(), WM_COMMAND, CMD_ADD_TO_NEW_FOLDER, 0
End Sub
Le nom du dossier est "Dossier x"
J'aimerais la modifier de façon à ce que le nom du dossier soit "VISSERIE"
Le problème c'est que je ne sais pas lire le VBA (pas plus qu'un autre langage d'ailleurs).
- Dans l'exemple de l'api, seul les composants " valve<1> and valve_guide<1> " sont placé dans un dossier "new folder".
- Dans la macro que j'ai récupéré, l'action se fait su les composants sélectionnée (a terme, je compte utiliser un filtre de sélection en fonction d'une propriété personnalisé)
Il faudrait que je fasse une chimère mais je ne sais pas bien ou couper la bête.
Y a il dans l'API un dictionnaire des fonction auquel je pourrais me référer pour mieux comprendre le fonctionnement des macro que je récupère ça et là?
Ca me permettrait de trouver le terme qui gère le nom du dossier dans la macro que j'ai récupéré.
Commence déjà par du vba excel, c'est plus facile pour comprendre le language (https://www.excel-pratique.com/fr/vba.php), puis sur le site codestack ou tu as pris le 1er code tu as une multitude de tuto(https://www.codestack.net/solidworks-api/document/)
La personne qui a écrit la macro que tu as récupérée considère que la commande de création d'un dossier n'existe pas dans les API Solidworks et est donc passé par les API Windows pour envoyer une commande à Solidworks et comme il met dans sa page d'explication que tu peux trouver ICI, "The challenge is how to discover the id of the required command ". Dans l'API Solidworks, la fonction est "InsertFeatureTreeFolder2".
Dans l'exemple issu de l'API, il faut se raccrocher à ton assemblage ouvert dans Solidworks puis faire une boucle pour récupérer les éléments sélectionnés. Toutes les fonctions nécessaires à l'utilisation de l'API Solidworks est par ICI.
La macro, en version courte (sans vérification et gestion des erreurs) et par les API Solidworks, doit pouvoir ressembler à ça :
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim modelDoc2 As SldWorks.modelDoc2
Dim assemblyDoc As SldWorks.assemblyDoc
Dim featureMgr As SldWorks.FeatureManager
Dim modelDocExt As SldWorks.ModelDocExtension
Dim selectionMgr As SldWorks.selectionMgr
Dim feature As SldWorks.feature
Dim selObj As Object
Dim count As Long
Dim componentToMove As SldWorks.Component2
Dim componentsToMove() As Object
Dim i As Long
Dim retVal As Boolean
Sub Main()
Set swApp = Application.SldWorks
Set modelDoc2 = swApp.ActiveDoc
Set assemblyDoc = modelDoc2
'Récupération des élements sélectionnés dans Solidworks
Set modelDocExt = modelDoc2.Extension
Set selectionMgr = modelDoc2.SelectionManager
Set selObj = selectionMgr.GetSelectedObject6(1, -1)
count = selectionMgr.GetSelectedObjectCount2(0)
ReDim componentsToMove(count - 1)
For i = 0 To count - 1
Set componentToMove = selectionMgr.GetSelectedObjectsComponent4(i + 1, -1)
Set componentsToMove(i) = componentToMove
Next
'Création d'un nouveau dossier
Set featureMgr = modelDoc2.FeatureManager
Set feature = featureMgr.InsertFeatureTreeFolder2(swFeatureTreeFolder_EmptyBefore)
Set feature = assemblyDoc.FeatureByName(feature.Name)
'Déplacement des élements sélectionnés dans le nouveau dossier
retVal = assemblyDoc.ReorderComponents(componentsToMove, feature, swReorderComponents_LastInFolder)
'Changement de nom du dossier
feature.Name = "Visserie"
End Sub
Je viens de tester quelque chose sur un assemblage comportant des sous assemblages, et ca à l'aire de coincer. Il faut que j'arrive à faire une sélection sur le premier niveau seulement. je pense pas avoir le temps de m'y plonger aujourd'hui.
Au final, si j'arrive à mes fins, cela me donnera une macro plus puissante que le TreeManager de MycadTool qui ne permet pas de faire plusieurs action de tris ni d'enregistrer ces actions.