Hallo
Ik heb hulp nodig bij het invullen van deze macro
Ik heb een macro gemaakt om blokken toe te voegen op het 1e vel van een tekening, het werkt goed,
Maar soms heb ik folio's van 2 tot xx en zou ik graag een functie (ALS) willen plaatsen als er andere bladeren zijn, voeg dan andere blokken toe op alle folio's op een specifieke plaats:
Zie de bijgevoegde code, het 1e deel werkt op zichzelf, maar als ik het 2e deel toevoeg, werkt het niet (ik weet dat het normaal is, maar ik hack alleen zonder training, ik heb veel dingen geprobeerd die niet werkten) :-(
Heeft u een oplossing?
Bedankt
macro.txt
Hallo
Kijk naar het voorbeeld hier, hiermee kunt u alle bladen van een plan opsommen, u hoeft alleen maar code in te voeren voor de activering van het gewenste blad (ActivateSheet-methode ) en uw code voor het positioneren van het blok tussen de regels:
Voor i = 0 Naar Ubound(vSheetNames)
en
volgende i
Vriendelijke groeten
Hallo
Dus zoiets als het volgende:
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
Vergeet niet om de naam van je blok te wijzigen in de regel Set swSketchBlockDef = swSketchMgr.MakeSketchBlockFromFile(........)
Aan te passen aan uw behoeften ...
Vriendelijke groeten
1 like
Hallo d.Roger,
Bedankt voor de code, maar ik heb 2 problemen met:
1)- De blokken passen niet op de basiskaarten, ik denk dat het ontbreekt (zie hieronder) maar het werkt niet
De basiskaart bewerken
Deel.EditTemplate
Deel.EditSketch
Deel.ClearSelection2 Waar
2)-De blokken en hun locaties staan op één plek op de achtergrond van blad 1, en op alle andere vellen die volgen, deze andere blokken zijn ook op een andere plek op het achtergrondplan geplaatst (zie bijgevoegde afbeelding)
Wees voorzichtig, het zijn niet allemaal noodzakelijkerwijs meerdere vellen, ik ben bang voor de bug als er maar één vel is
Vraag: de invoegpunten van de blokken zijn geldig voor de A0, ik weet dat de delta X - en Y - tussen de A0 en de A1, A2, A3 kun je een positieregel geven op basis van de grootte van de achtergrond vanaf het begin van de macro, zoals ALS de achtergrond A1 is, dan waarde X-2# Y-0.1; Als de basiskaart A2 is, dan is de waarde X-3# Y-0.2; .......
Bedankt voor de tijd die je hebt besteed aan het helpen van mij
test_macro.pdf
Hallo
Voor punt 1 heb je het in je verzoek over het invoegen van een blok op vellen, als het op de achtergronden staat, dan moet je inderdaad voor elk vel het bewerken en het betreffende blok invoegen.
Voor punt 2 moeten we parameters toevoegen aan de functie insertBloc(), deze parameters moeten ons in staat stellen om de waarden aan de variabelen nPt(0), nPt(1) en de naam van het blok te geven. Als u deze parameters op basis van de basiskaart wilt verzenden, moet u de grootte van de basiskaart nemen met behulp van de GetSize-methode die hoort bij de ISheet-interface in de API's en vervolgens de VBA Select Case-structuur gebruiken.
Voor punt 3, als u slechts één blad hebt, zal de functie Voor i = 0 Naar UBound(vSheetNames) van 0 naar 0 lopen, maar zou geen fout moeten genereren.
Het zou er dus als volgt uit kunnen zien (dit moet natuurlijk worden aangepast aan uw posities en de namen van de in te voegen blokken):
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
Vriendelijke groeten
1 like
Hallo d.Roger,
Bedankt voor je hulp, ik heb dan 58 dozen te doen.
Als ik tijd heb, ga ik ermee aan de slag en neem ik contact met je op om je te vertellen of het werkt.
Nogmaals bedankt