---

Hallo, ich habe mal wieder ein Problem mit Blöcken
Thema 1: ich kopiere ein Blatt dieses enthält Blöcke auf dem Blatt, die beim Kopieren nicht mit kopiert werden. Gibt es eine Möglichkeit diese mit zu Kopieren ohne sie vorher aufzulösen?
'edit hab einen Weg in der SWX Api gefunden, funktioniert.

Copy Sheet Code:
--------------------
Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Part As DrawingDoc
Dim swModel As ModelDoc2
Dim boolstatus As Boolean

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set Part = swModel

    If (Part Is Nothing) Then
        MsgBox " Please open a drawing document. "
        End
    End If

    Dim currentsheet As Sheet
    Set currentsheet = Part.GetCurrentSheet
    Part.ActivateSheet (currentsheet.GetName)
    Debug.Print "Active sheet: " & currentsheet.GetName
    boolstatus = Part.Extension.SelectByID2(currentsheet.GetName, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
    swModel.EditCopy

    Part.ClearSelection2 True

End Sub

---------------

Anschließed füge ich das Kopierte Blatt in einer BG Zeichnung am Ende ein, ohne Blöcke umzubenennen.

Paste Sheet Code:
-----------
' Makro fügt kopiertes Blatt am Ende ein
' springt danach zurück auf Blatt 1

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Part As DrawingDoc
Dim swModel As ModelDoc2
Dim boolstatus As Boolean
Dim i As Integer
Dim bRet As Boolean
Dim swDraw As SldWorks.DrawingDoc
Dim vSheetName As Variant
Dim vSheets As Variant
Dim swSheet As SldWorks.Sheet

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set Part = swModel

    If (Part Is Nothing) Then
        MsgBox " Please open a drawing document. "
        End
    End If

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    vSheets = swDraw.GetSheetNames
   
' ermittlung letztes Blatt
    For i = 1 To swDraw.GetSheetCount
        swDraw.ActivateSheet vSheets(i - 1)
        swDraw.ViewZoomtofit2
        Set swSheet = swDraw.GetCurrentSheet

    Next i

    Dim currentsheet As Sheet
    boolstatus = Part.PasteSheet(swInsertOption_AfterSelectedSheet, swRenameOption_No) 'fügt ein ohne Blöcke umzubenennen
    Set currentsheet = Part.GetCurrentSheet
    'Part.ActivateSheet (GetLastSheet)
    Debug.Print "Active sheet: " & currentsheet.GetName
   
   

' schalte wieder auf Blatt 1

        swDraw.ActivateSheet vSheets(0)
        swDraw.ViewZoomtofit2

End Sub

--------------------

Hier passiert es das teilweise die Blattformate nicht dargestellt werden. Dies lässt sich lösen durch ein Reload des Blattformates. Händisch kein Problem hier kann ich sagen Blöcke nicht umbenennen (das Thema gab es hier schon vor vielen Jahren aber keine API Lösung).

Reload Blattformat Code:

' Makro lädt aktuelles Blattformat neu für alle Blätter
' setzt Blatt 1 wieder aktiv
' Alle Blätter Zoom Grenzen

Sub main()

Dim swApp              As SldWorks.SldWorks
Dim swModel            As SldWorks.ModelDoc2
Dim swDraw             As SldWorks.DrawingDoc
Dim swSheet            As SldWorks.Sheet
Dim vSheetProps        As Variant
Dim vSheetName         As Variant
Dim vTemplateName      As Variant

Dim longstatus         As Long
Dim longwarnings       As Long
Dim nErrors            As Long
Dim nWarnings          As Long
Dim i                  As Long

'***************************************

On Error Resume Next

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
If swModel Is Nothing Then
        MsgBox "Keine 2D Zeichung geöffnet!"
        Exit Sub
End If
  
If swModel.GetType <> swDocDRAWING Then
        MsgBox "Keine 2D Zeichung geöffnet!"
        Exit Sub
End If

Set swDraw = swModel
  
    vSheetName = swDraw.GetSheetNames

    ' Traverse the drawing sheets
    For i = 0 To UBound(vSheetName)

        swDraw.ActivateSheet vSheetName(i)
        Set swSheet = swDraw.GetCurrentSheet
      
        'Get the current drawing sheet format from this sheet
        vTemplateName = swSheet.GetTemplateName
      
        vSheetProps = swSheet.GetProperties
  
    'Set the sheet format to NONE
    swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateNone, vSheetProps(2), vSheetProps(3), True, "", vSheetProps(5), vSheetProps(6), "Default", True
  
    'Reload original sheet format for this sheet
    swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), True, vTemplateName, vSheetProps(5), vSheetProps(6), "Default", True
    swDraw.ViewZoomtofit2
  
  
  
  
Next i

    swDraw.ActivateSheet vSheetName(0)
    swDraw.ForceRebuild3 False
    swDraw.Save3 1, nErrors, nWarnings
      
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

MsgBox "Blatt wurde aktualisiert..."

End Sub

werden die Blöcke umbenamt, darauf würde ich gern verzichten, schon um einen Überblick über die vielen Blöcke zu behalten.

------------------
-----------------------------
der frühe Vogel kann mich mal

[Diese Nachricht wurde von EC-Jens am 13. Nov. 2023 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP