Witam
Potrzebuję pomocy w ukończeniu tego makra
Zrobiłem makro do dodawania bloków na 1 arkuszu rysunku, działa dobrze,
Ale czasami mam folio od 2 do xx i chciałbym umieścić funkcję (IF), jeśli są inne liście, a następnie dodać inne bloki na wszystkich folio w określonym miejscu:
Zobacz załączony kod, 1. część działa sama, ale kiedy dodaję 2. część, nie działa (wiem, że to normalne, ale hackuję tylko bez treningu, próbowałem wielu rzeczy, które nie działały) :-(
Czy masz rozwiązanie?
Dziękuję
macro.txt
Witam
Spójrz na przykład tutaj, ten pozwala wyświetlić listę wszystkich arkuszy planu, wystarczy wstawić kod do aktywacji żądanego arkusza (metoda ActivateSheet ) i kod do pozycjonowania bloku między wierszami:
Dla i = 0 Do Ubound(vSheetNames)
i
Dalej i
Pozdrowienia
Witam
Czyli coś takiego:
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
Pamiętaj, aby zmienić nazwę swojego bloku w wierszu Set swSketchBlockDef = swSketchMgr.MakeSketchBlockFromFile(........)
Do dostosowania do Twoich potrzeb...
Pozdrowienia
1 polubienie
Witaj D.Roger,
Dzięki za kod, ale mam 2 problemy z:
1)- Bloki nie mieszczą się na mapach bazowych, myślę, że ich brakuje (patrz poniżej), ale to nie działa
Edytowanie mapy bazowej
Part.EditTemplate (Szablon części)
Part.EditSketch
Part.ClearSelection2 Prawda
2) -Bloki i ich lokalizacje znajdują się w jednym miejscu na tle arkusza 1, a na wszystkich innych arkuszach, które następują, te inne bloki są również umieszczane w innym miejscu na planie tła (patrz załączony obrazek)
Uważaj, nie wszystkie z nich muszą mieć kilka arkuszy, boję się błędu w przypadku, gdy jest tylko jeden arkusz
Pytanie: punkty wstawiania bloków są prawidłowe dla A0, znam deltę X - i Y - między A0 a A1, A2, A3 czy możesz podać regułę pozycji zgodnie z rozmiarem tła od początku makra, na przykład JEŚLI tło to A1, to wartość X-2 # Y-0.1; Jeśli mapa bazowa to A2, to wartość X-3# Y-0,2; .......
Dziękuję za czas, który poświęciłeś na pomoc mi
test_macro.pdf
Witam
W punkcie 1, w swoim wniosku mówisz o wstawieniu bloku na arkuszach, jeśli jest on na tłach, to tak, dla każdego arkusza musisz go edytować i wstawić dany blok.
Dla punktu 2 musimy dodać parametry do funkcji insertBloc(), parametry te muszą pozwolić nam na podanie wartości zmiennym nPt(0), nPt(1) oraz nazwy bloku. Aby wysłać te parametry na podstawie mapy bazowej, należy określić rozmiar mapy bazowej przy użyciu metody GetSize należącej do interfejsu ISheet w interfejsach API, a następnie użyć struktury VBA Select Case.
W przypadku punktu 3, jeśli masz tylko jeden arkusz, funkcja For i = 0 To UBound(vSheetNames) zapętli się od 0 do 0, ale nie powinna wygenerować błędu.
Może to zatem wyglądać następująco (oczywiście należy to dostosować do swoich pozycji i nazw bloków, które mają zostać wstawione):
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
Pozdrowienia
1 polubienie
Witaj D.Roger,
Dziękuję za pomoc, mam wtedy do zrobienia 58 pudełek.
Kiedy będę miał czas, zajmę się tym i skontaktuję się z Tobą, aby powiedzieć, czy to działa.
Jeszcze raz dziękuję