Macro pour choisir la position d'un bloc dans une mise en plan

Bonjour à tous,

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 ;-)

Merci d'avance,

Cordialement.

 

1 « J'aime »

Salut,

En fait le premier argument de ta méthode MakeSketchBlockFromFile est la position !

Dans ton exemple, tu as mis "nothing" donc je pense que par défaut, il s'insère au point d'ancrage de ta mise en plan.

Donc tu as deux solutions : changer le point d'ancrage de tes modèles de mise en plan, ou modifier ce nothing pour choisir ton point comme ceci :

InsertionPoint
Insertion point, which must be a 2D point with z = 0.0, for the block definition
 

La page correspondante : 

http://help.solidworks.com/2012/English/api/sldworksapi/SolidWorks.interop.sldworks~SolidWorks.interop.sldworks.ISketchManager~MakeSketchBLockFromFile.html

3 « J'aime »

Tout d'abord merci de ton aide.

Je ne souhaite pas toucher à mes modèles

Cependant je ne sais pas comment retranscrire cette nouvelle ligne a mon code.

 A quo- va-t-elle resenblé ? A quel endroit dois-je la mettre ?

Y a t'il des coordonnées en X et en Y ?

Merci d'avance

1 « J'aime »

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 :

http://help.solidworks.com/2012/English/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IMathPoint.html

Plus de précisions pour créer le point :

 'Create the new MathPoint from the sketch point data.

    'MathP refers to the point location in the sketch coordinates

    Set MathP = MathUtil.CreatePoint(PointCoords)

    'Display the point coordinates in relation to the sketch origin

    SketchPoints = MathP.ArrayData

    MsgBox SketchPoints(0) & ", " & SketchPoints(1) & ", " & SketchPoints(2)

http://help.solidworks.com/2012/English/api/sldworksapi/Transform_Sketch_to_Model_Example_VB.htm

 

2 « J'aime »

J'avoue être perdu...

Voici ce que j'ai fait mais sans aucun résultat :

 

Set swApp = _
Application.SldWorks

Set Part = swApp.ActiveDoc
Part.EditTemplate
Part.EditSketch

Set MathP = MathUtil.CreatePoint(PointCoords)
SketchPoints = MathP.ArrayData

    MsgBox SketchPoints(0) & "5,0 " & SketchPoints(1) & "5,0 " & SketchPoints(2)


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

Dans ta ligne :

Part.SketchManager.MakeSketchBlockFromFile(Nothing, "D:\_MAIA\1_MODELES\4_BLOCS-TAMPONS\Tol ISO2768 - EN22768 - mK.SLDBLK", False, 1, 0)

 

Tu utilises toujours Nothing

Comme je te l'ai dit, il faut remplacé ceci par un point d'insertion !

Et dans ta ligne :

SketchPoints = MathP.ArrayData

Tu n'as pas renseigné les coordonées.

 

Tu connais la programmation vba ?

1 « J'aime »

Il y a un exemple peut-être plus parlant pour t'aider ici :

'NEW BLOCKS: Create block definition

    Set swSketchBlockDef = swSketchMgr.MakeSketchBlockFromSelected(Nothing)

    '

    ' Define an insertion point

    nPt(0) = 60# / 1000#

    nPt(1) = -60# / 1000#

    nPt(2) = 0#

    vPt = nPt

    Set swMathPoint = swMathUtil.CreatePoint(vPt)

    '

    ' Insert an instance of the block definition

    Set swBlockInst = swSketchMgr.InsertSketchBlockInstance(swSketchBlockDef, swMathPoint, 1, 0)

http://help.solidworks.com/2013/English/api/sldworksapi/Create_Block_Definition_and_Insert_Block_Instance_Example_VB.htm

1 « J'aime »

Finalement j'ai changé les points d'ancrage des blocs.

Merici  PL

1 « J'aime »

Bonjour Bec2

Comment avez-vous changé l’ancrage de ceux-ci ?

Car je ne m’y connais pas trop en VBA et j’ai pour l’instant bidouiller pour faire venir mon bloc mais il ne se met pas au bon endroit.

Bonjour et bienvenue @sebastien_higaxo5742 .

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.

image

1 « J'aime »