Je suis actuellement entrain de créer des boutons macros afin d'insérer des blocs dans le fond de plan d'une mise en plan.
Jusqu'ici rien de compliqué j'ai un code qui fonctionne très bien :
Set swApp = _ Application.SldWorks
Set Part = swApp.ActiveDoc Part.EditTemplate Part.EditSketch Dim myBlockDefinition As Object Set myBlockDefinition = Part.SketchManager.MakeSketchBlockFromFile(Nothing, "D:\_MAIA\1_MODELES\4_BLOCS-TAMPONS\Tol ISO2768 - EN22768 - mK.SLDBLK", False, 1, 0) Part.EditSheet Part.EditSketch End Sub
Mon problème concerne la position du bloc sur la mise en plan, j'aimerais pouvoir lui prédéfinir une position dans mon code ( en X et en Y ).
Actuellement lorsque je lance la macro le bloc s'insère dans le coin gauche inférieur de la mise en plan.
J'ai tenté pas mal de chose mais sans succès.
Si quelqu'un si connais en VBA je suis preneur ;-)
Donc avant d'insérer ton bloc, il faudra créer et nommer ton point d'intsersetion que tu utiliseras à la place de ton "nothing", voir ce lien pour créer le point :
Dim myBlockDefinition As Object Set myBlockDefinition = Part.SketchManager.MakeSketchBlockFromFile(Nothing, "D:\_MAIA\1_MODELES\4_BLOCS-TAMPONS\Tol ISO2768 - EN22768 - mK.SLDBLK", False, 1, 0) Part.EditSheet Part.EditSketch Part.ClearSelection2 True End Sub
Voici une macro Vba pour insérer un block en choisissant ses points de coordonnées:
Dim swApp As Object
Dim swModel As Object
Dim swDrawing As Object
Dim swSheet As Object
Dim swBlockDef As Object
Dim swBlockIns As Object
Sub InsertBlockAtPoint()
' Se connecter à l'application SolidWorks
Set swApp = Application.SldWorks
' Obtenir le document actif (supposé être un dessin)
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Veuillez ouvrir un document de dessin."
Exit Sub
End If
' Vérifier si le document actif est un dessin
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
MsgBox "Le document actif n'est pas un dessin."
Exit Sub
End If
Set swDrawing = swModel
' Obtenir la feuille active
Set swSheet = swDrawing.GetCurrentSheet
' Spécifier le chemin vers la définition du bloc
Dim blockPath As String
blockPath = "C:\Chemin\Vers\Votre\Bloc.sldblk" ' Changez ceci par le chemin de votre bloc
' Charger la définition du bloc
Set swBlockDef = swDrawing.LoadBlockDefinition(blockPath)
If swBlockDef Is Nothing Then
MsgBox "Échec du chargement de la définition du bloc."
Exit Sub
End If
' Définir les coordonnées du point d'insertion
Dim insertPoint(2) As Double
insertPoint(0) = 0.1 ' Coordonnée X en mètres
insertPoint(1) = 0.1 ' Coordonnée Y en mètres
insertPoint(2) = 0 ' Coordonnée Z (généralement 0 pour les dessins 2D)
' Insérer le bloc au point spécifié
Set swBlockIns = swSheet.InsertBlock(swBlockDef, insertPoint)
If swBlockIns Is Nothing Then
MsgBox "Échec de l'insertion du bloc."
Else
MsgBox "Bloc inséré avec succès."
End If
End Sub
ensuite, quelques remarques pour vos prochaines demandes:
Évitez à l’avenir de déterrer des postes Résolu de 2016… surtout si un des intervenant n’a pas publié récemment.