Macro Adding Blocks to Multiple Sheets of an Active Drawing

Hello

I need help completing this macro 
I made a macro to add blocks on the 1st sheet of a drawing it works well,
But sometimes I have folios from 2 to xx and I would like to place a function (IF) if there are other leaves then add other blocks on all the folios in a specific place: 
See the attached code the 1st part works on its own, but when I add the 2nd part it doesn't work (I know it's normal, but I only do hacking without training, I tried a lot of things that didn't work) :-(
Do you have a solution? 

Thank you 


macro.txt

Hello

Look at the example here, this one allows you to list all the sheets of a plan, you just have to insert code for the activation of the desired sheet (ActivateSheet method ) and your code for positioning the block between the lines:

For i = 0 To Ubound(vSheetNames)

and

Next i

Kind regards

Hello

So something like the following:

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

Remember to change the name of your block in the line Set swSketchBlockDef = swSketchMgr.MakeSketchBlockFromFile(........)

To be adapted to your needs ...

Kind regards

1 Like

 Hello d.Roger,

Thanks for the code, but I have 2 problems with:

1)- The blocks don't fit on the basemaps, I think it's missing (see below) but it doesn't work
    Editing the basemap
    Part.EditTemplate
    Part.EditSketch
   Part.ClearSelection2 True

2)-The blocks and their locations are in one place on the background of sheet 1, and on all the other sheets that follow, this other blocks are placed in another place on the background plan as well (see attached image)

Be careful not all of them are necessarily several sheets, I'm afraid of the bug in case there is only one sheet 

Question: the insertion points of the blocks are valid for the A0, I know the delta X-- and Y-- between the A0 and the A1, A2, A3 can you give a position rule according to the size of the background from the start of the macro, like IF the background is A1 then value X-2# Y-0.1;  If the basemap is A2 then value X-3# Y-0.2; .......

Thank you for the time you spend helping me


test_macro.pdf

Hello

For point 1, in your request you talk about inserting a block on sheets, if it's on the backgrounds then yes for each sheet you have to edit it and insert the block in question.

For point 2, we need to add parameters to the insertBloc() function, these parameters must allow us to give the values to the variables nPt(0), nPt(1) and the name of the block. To send these parameters based on the basemap, you will need to take the size of the basemap using the GetSize method belonging to the ISheet interface in the APIs, and then use the VBA Select Case structure.

For point 3, if you only have one sheet then the For i = 0 To UBound(vSheetNames) function will loop from 0 to 0 but should not generate an error.

It could therefore look like the following (of course, this is to be adapted according to your positions and names of the blocks to be inserted):

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

 

Kind regards

1 Like

 Hello d.Roger,

Thank you for your help, I have 58 boxes to do then.
When I have time, I'll get on it and get back to you to tell you if it works.
Thanks again