Hallo
Ich benötige Hilfe beim Ausfüllen dieses Makros
Ich habe ein Makro erstellt, um Blöcke auf dem 1. Blatt einer Zeichnung hinzuzufügen, es funktioniert gut,
Aber manchmal habe ich Folios von 2 bis xx und ich möchte eine Funktion (IF) platzieren, wenn es andere Blätter gibt, dann füge andere Blöcke auf allen Folios an einer bestimmten Stelle hinzu:
Sehen Sie sich den angehängten Code an, der 1. Teil funktioniert von alleine, aber wenn ich den 2. Teil hinzufüge, funktioniert er nicht (ich weiß, es ist normal, aber ich hacke nur ohne Schulung, ich habe viele Dinge ausprobiert, die nicht funktioniert haben) :-(
Haben Sie eine Lösung?
Vielen Dank
macro.txt
Hallo
Schauen Sie sich das Beispiel hier an, dieses ermöglicht es Ihnen, alle Blätter eines Plans aufzulisten, Sie müssen nur den Code für die Aktivierung des gewünschten Blattes (ActivateSheet-Methode ) und Ihren Code für die Positionierung des Blocks zwischen den Zeilen einfügen:
Für i = 0 Bis Ubound(vSheetNames)
und
Weiter i
Herzliche Grüße
Hallo
Also so etwas wie folgt:
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
Denken Sie daran, den Namen Ihres Blocks in der Zeile Set swSketchBlockDef = swSketchMgr.MakeSketchBlockFromFile(........) zu ändern.
Zur Anpassung an Ihre Bedürfnisse ...
Herzliche Grüße
1 „Gefällt mir“
Hallo d.Roger,
Danke für den Code, aber ich habe 2 Probleme mit:
1)- Die Blöcke passen nicht auf die Grundkarten, ich denke, es fehlt (siehe unten), aber es funktioniert nicht
Bearbeiten der Grundkarte
Part.EditTemplate
Part.EditSketch
Part.ClearSelection2 Wahr
2)-Die Blöcke und ihre Positionen befinden sich an einer Stelle auf dem Hintergrund von Blatt 1, und auf allen anderen Blättern, die darauf folgen, werden diese anderen Blöcke ebenfalls an einer anderen Stelle auf dem Hintergrundplan platziert (siehe beigefügtes Bild)
Seien Sie vorsichtig, nicht alle sind notwendigerweise mehrere Blätter, ich habe Angst vor dem Fehler, falls es nur ein Blatt gibt
Frage: Die Einfügepunkte der Blöcke sind für A0 gültig, ich kenne das Delta X - und Y - zwischen A0 und A1, A2, A3. Können Sie eine Positionsregel entsprechend der Größe des Hintergrunds vom Anfang des Makros aus angeben, z. B. wenn der Hintergrund A1 ist, dann Wert X-2# Y-0.1; Wenn die Grundkarte A2 ist, dann Wert X-3# Y-0,2; .......
Vielen Dank für die Zeit, die Sie mir genommen haben
test_macro.pdf
Hallo
Zu Punkt 1, in Ihrer Anfrage sprechen Sie über das Einfügen eines Blocks auf Blättern, wenn es sich auf den Hintergründen befindet, dann ja, für jedes Blatt müssen Sie es bearbeiten und den betreffenden Block einfügen.
Für Punkt 2 müssen wir der Funktion insertBloc() Parameter hinzufügen, diese Parameter müssen es uns ermöglichen, die Werte für die Variablen nPt(0), nPt(1) und den Namen des Blocks anzugeben. Um diese Parameter basierend auf der Grundkarte zu senden, müssen Sie die Größe der Grundkarte mit der GetSize-Methode ermitteln, die zur ISheet-Schnittstelle in den APIs gehört, und dann die VBA-Struktur Select Case verwenden.
Wenn Sie für Punkt 3 nur über ein Blatt verfügen, wird die Funktion For i = 0 To UBound(vSheetNames) von 0 bis 0 geführt, sollte jedoch keinen Fehler generieren.
Es könnte also wie folgt aussehen (dies ist natürlich entsprechend Ihrer Positionen und Namen der einzufügenden Blöcke anzupassen):
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
Herzliche Grüße
1 „Gefällt mir“
Hallo d.Roger,
Vielen Dank für Ihre Hilfe, ich habe dann 58 Kisten zu erledigen.
Wenn ich Zeit habe, werde ich mich darum kümmern und mich bei Ihnen melden, um Ihnen zu sagen, ob es funktioniert.
Danke noch einmal