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