Makro: Hinzufügen von Blöcken zu mehreren Blättern einer aktiven Zeichnung

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