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