---

Liebe Kollegen,
ich möchte ein Makro schreiben, welches bestimmte Blöcke temporär mit der zugehörigen Datei verbinden soll.
Ich habe den unten angehängten Code geschrieben.
Das Problem ist nun, dass die Verbindung sauber funktioniert, das Trennen aber nicht. iblock.LinkToFile bleibt Wahr, was immer ich da anstelle, obwohl der Weg mit iBlock=false ordentlich durchlaufen wird. Hat da irgendjemand eine Idee oder ist das ein Bug in meiner SWX-Version 2009.
(Anmerkung:Ich weiß, dass der Code nur für Testzwecke geeignet ist. Zur Identifizierung der zur ändernden Blöcke muss ich dann über die Instanzen gehen 

Code:
' Makro zur Verbindung/Trennung von Blöcken mit ihrer Datei
' Autor: Volkmar Grube
' 28.11.2011

Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim skMgr As SldWorks.SketchManager

Dim pBlock As SldWorks.SketchBlockDefinition

Dim pInst As SldWorks.SketchBlockInstance

Dim leaderPt As SldWorks.MathPoint

Dim insPt As SldWorks.MathPoint

Dim vInstPt As Variant

Dim vInstances As Variant

Dim vBlocks As Variant

Dim nInstanceCount As Long

Dim itr As Long

Dim jtr As Long

Dim bLinkToFile As Boolean

Sub BlockStatusUmschalten(iblock As SldWorks.SketchBlockDefinition, Verbinden As Boolean)
  swModel.EditTemplate
  If Verbinden Then
    ' Block defintion linked to file?
    iblock.LinkToFile = True
    ' Block linked file name
    iblock.FileName = "s:\SWVorlagen\Sfeldsw.SLDBLK"
  Else
    ' Block defintion linked to file?
    iblock.LinkToFile = False
    ' Block linked file name
    iblock.FileName = " "
  End If
  swModel.GraphicsRedraw2
  swModel.EditSheet
  swModel.ForceRebuild3 (True)
End Sub

Sub Verbinden()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set skMgr = swModel.SketchManager

    vBlocks = skMgr.GetSketchBlockDefinitions
    ' Exit if no blocks
    If IsEmpty(vBlocks) Then
        Exit Sub
    End If
    ' Process block definitions
    For itr = 0 To UBound(vBlocks)
      Set pBlock = vBlocks(itr)
      BlockStatusUmschalten pBlock, True
    Next itr
End Sub

Sub Trennen()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set skMgr = swModel.SketchManager

    vBlocks = skMgr.GetSketchBlockDefinitions
    ' Exit if no blocks
    If IsEmpty(vBlocks) Then
        Exit Sub
    End If
    ' Process block definitions
    For itr = 0 To UBound(vBlocks)
      Set pBlock = vBlocks(itr)
      BlockStatusUmschalten pBlock, False
    Next itr
End Sub

------------------
Grüße aus Dresden
Volkmar Grube

Es gibt keine Probleme, es gibt nur Aufgaben.

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