Macro ajout des blocs sur plusieurs feuilles d’une mise en plan active

Bonjour,

J'ai besoin d'aide pour compléter cette macro 
J’ai fait une macro pour ajout des blocs sur la 1er feuille d’une mise en plan elle marche bien,
Mais parfois, j’ai des folios de 2 à xx et je voudrais placer une fonction (IF) si il y a d’autre feuilles alors ajout d’autre blocs sur tous les folios à un endroit spécifique : 
Voir le code ci-joint la 1er partie marche seul, mais quand j’ajoute la 2e partie ça marche pas (je sais c'est normal, mais je fais que de la bidouille sans formation, j'ai essayé plein de chose qui non pas marché ) :-(
Avez-vous une solution ? 

Merci 


macro.txt

Bonjour,

Regarde l'exemple qui se trouve ICI, celui-ci permet de lister toutes les feuilles d'un plan, tu n'as plus qu'à insérer du code pour l'activation de la feuille voulue (méthode ActivateSheet) et ton code de positionnement du bloc entre les lignes :

For i = 0 To Ubound(vSheetNames)

et

Next i

Cordialement,

Bonjour,

Donc quelque chose comme ce qui suit :

Option Explicit

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swDraw                      As SldWorks.DrawingDoc
Dim swSketchBlockDef            As SldWorks.SketchBlockDefinition
Dim swBlockInst                 As SldWorks.SketchBlockInstance
Dim swSketchMgr                 As SldWorks.SketchManager
Dim swModelDocExt               As SldWorks.ModelDocExtension
Dim swSheet                     As SldWorks.Sheet
Dim vSheetNames                 As Variant
Dim bRet                        As Boolean
Dim i                           As Long
Dim swMathUtil                  As SldWorks.MathUtility
Dim swMathPoint                 As SldWorks.MathPoint
Dim nPt(2)                      As Double
Dim vPt                         As Variant
 
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    vSheetNames = swDraw.GetSheetNames
    For i = 0 To UBound(vSheetNames)
        swDraw.ActivateSheet (vSheetNames(i))
        insertBloc
    Next i
    swDraw.ActivateSheet (swSheet.GetName)
End Sub

Sub insertBloc()
    Set swSketchMgr = swModel.SketchManager
    Set swModelDocExt = swModel.Extension
    Set swMathUtil = swApp.GetMathUtility

    swModel.ClearSelection2 True

    nPt(0) = 6# / 1000#
    nPt(1) = 6# / 1000#
    nPt(2) = 0#
    vPt = nPt
    Set swMathPoint = swMathUtil.CreatePoint(vPt)

    Set swSketchBlockDef = swSketchMgr.MakeSketchBlockFromFile(swMathPoint, "Chemin et nom de ton bloc", False, 1, 0)

    swModel.GraphicsRedraw2
End Sub

Pense à modifier le nom de ton bloc dans la ligne Set swSketchBlockDef = swSketchMgr.MakeSketchBlockFromFile(........)

A adapter à ton besoin ...

Cordialement,

1 « J'aime »

Bonjour d.Roger,

Merci pour le code, mais j'ai 2 problèmes avec:

1)- Les blocs ne s'insère pas sur les fonds de plans, je pense qu'il manque (voir ci-dessous) mais ça marche pas 
    'Edition du fond de plan
    Part.EditTemplate
    Part.EditSketch
   Part.ClearSelection2 True

2)-Les blocs et leurs emplacements sont à un endroit sur le fond de plan de la feuille1, et sur toutes les autres feuilles qui suivent, ce son d'autre blocs placer à un autre endroit sur le fond de plan aussi (voir image joint)

Attention tous les misent en plan non pas forcement plusieurs feuilles, j'ai peur du bug au cas où il n'y a qu'une feuille 

Question: les points d'insertion des blocs sont valable pour le A0, je connais le délta X-- et Y-- entre le A0 et le A1, A2, A3 peux ton donner une règle de position en fonction de la taille du fond de plan dès le départ de la macro, genre SI le fond de plan est A1 alors valeur X-2# Y-0.1; SI le fond de plan est A2 alors valeur X-3# Y-0.2; .......

Merci pour le temps que tu passe à m'aider


test_macro.pdf

Bonjour,

Pour le point 1, dans ta demande tu parles d'insertion d'un bloc sur des feuilles, si c'est sur les fonds de plan alors oui pour chaque feuille il faut éditer celui-ci et y insérer le bloc en question.

Pour le point 2, il faut ajouter des paramètres à la fonction insertBloc(), ces paramètres doivent permettre de donner les valeurs aux variables nPt(0), nPt(1) et le nom du bloc. Pour envoyer ces paramètres en fonction du fond de plan il te faudra relever la taille du fond de plan à l'aide de la Méthode GetSize appartenant à l'interface ISheet dans les API puis utiliser la structure VBA Select Case.

Pour le point 3, si tu n'as qu'une feuille alors la fonction For i = 0 To UBound(vSheetNames) bouclera de 0 à 0 mais ne devrait pas générer d'erreur.

Cela pourrait donc ressembler à ce qui suit (bien entendu, c'est à adapter suivant tes positions et noms de blocs à insérer) :

Option Explicit

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swDraw                      As SldWorks.DrawingDoc
Dim swSketchBlockDef            As SldWorks.SketchBlockDefinition
Dim swBlockInst                 As SldWorks.SketchBlockInstance
Dim swSketchMgr                 As SldWorks.SketchManager
Dim swModelDocExt               As SldWorks.ModelDocExtension
Dim swSheet                     As SldWorks.Sheet
Dim mySheet                     As SldWorks.Sheet
Dim paperSize                   As swDwgPaperSizes_e
Dim myBlockDefinition           As Object
Dim vSheetNames                 As Variant
Dim bRet                        As Boolean
Dim i                           As Long
Dim swMathUtil                  As SldWorks.MathUtility
Dim swMathPoint                 As SldWorks.MathPoint
Dim width                       As Double
Dim height                      As Double
Dim nPt(2)                      As Double
Dim vPt                         As Variant
Dim posX                        As Integer
Dim posY                        As Integer
Dim nomDuBloc                   As String
 
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    vSheetNames = swDraw.GetSheetNames
    For i = 0 To UBound(vSheetNames)
        swDraw.ActivateSheet (vSheetNames(i))

        Set mySheet = swDraw.GetCurrentSheet
        paperSize = mySheet.GetSize(width, height)

        Select Case paperSize
            Case 0
                posX = 10
                posY = 5
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\A.SLDBLK"
            Case 1
                posX = 3
                posY = 7
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\B.SLDBLK"
            Case 2
                posX = 10
                posY = 12
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\C.SLDBLK"
            Case 3
                posX = 10
                posY = 5
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\D.SLDBLK"
            Case 4
                posX = 10
                posY = 5
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\E.SLDBLK"
            Case 5
                posX = 10
                posY = 5
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\F.SLDBLK"
            Case 6
                posX = 10
                posY = 5
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\G.SLDBLK"
            Case 7
                posX = 10
                posY = 5
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\H.SLDBLK"
            Case 8
                posX = 8
                posY = 15
                nomDuBloc = "C:\Users\DRO\Bibliotheque_Annotations et blocs\I.SLDBLK"
            'Ainsi de suite jusqu'à Case 12
            '...
            Case Else
                Exit Sub
        End Select
        insertBloc swDraw, posX, posY, nomDuBloc
        swDraw.EditSheet
        swDraw.EditSketch
    Next i
    swDraw.ActivateSheet (swSheet.GetName)
End Sub

Sub insertBloc(swDrawing As SldWorks.DrawingDoc, X As Integer, Y As Integer, monBloc As String)
    Set swMathUtil = swApp.GetMathUtility

    nPt(0) = X / 1000#
    nPt(1) = Y / 1000#
    nPt(2) = 0#
    vPt = nPt
    Set swMathPoint = swMathUtil.CreatePoint(vPt)

    swDrawing.ClearSelection2 True
    swDrawing.EditTemplate
    swDrawing.EditSketch
    swDrawing.ClearSelection2 True
      
    Set swSketchBlockDef = swDrawing.SketchManager.MakeSketchBlockFromFile(swMathPoint, monBloc, False, 1, 0)

    swDrawing.GraphicsRedraw2
End Sub

 

Cordialement,

1 « J'aime »

Bonjour d.Roger,

Merci pour ton aide, j'ai 58 cases à faire alors.
Quand j'aurai le temps, je me mettrai dessus et reviendrai vers vous pour vous dire si ça marche.
Merci encore