---

Hallo zusammen,

ich bekomme ständig den Fehler 9 "End of Blockdefinition!!"
wie kann ich diesen fehler ausmärzen?
hier der code...

Public Sub ersetzeblock()
' Begin the selection
    Dim blockRefObj As AcadBlockReference
    Dim blockRefObj1 As AcadBlockReference
    Dim blockRefObj2 As AcadBlockReference
    Dim basePnt As Variant
    Dim basePnt1 As Variant
   
    On Error Resume Next
   
    'ThisDrawing.Utility.GetEntity blockRefObj1, basePnt, "mit Blockreferenz ersetzen:"
    Dim varAttributes1 As Variant
    Dim varAttributes As Variant
    Dim varAttributes2 As Variant
   
    ' The following example waits for a selection from the user
RETRY:
   
    ThisDrawing.Utility.GetEntity blockRefObj, basePnt1, "zu ersetzende Blockreferenz wählen:"
    varAttributes = blockRefObj.GetAttributes
    If Err <> 0 Then
        'Err.Clear
        MsgBox "Program ended." & Err.Number, , "GetEntity Example"
      Exit Sub
    ElseIf blockRefObj.Name = "RAUCHMEL" Then
        Set blockRefObj1 = ThisDrawing.ModelSpace.InsertBlock(blockRefObj.InsertionPoint, "HBS-40-RAUCHMELDER", 1#, 1#, 1#, blockRefObj.Rotation)
        varAttributes1 = blockRefObj1.GetAttributes
        varAttributes1(0).TextString = varAttributes(0).TextString
        varAttributes1(1).TextString = varAttributes(1).TextString
        blockRefObj.Delete
        blockRefObj1.Update
    ElseIf blockRefObj.Name = "ZWDMEL" Then
        Set blockRefObj2 = ThisDrawing.ModelSpace.InsertBlock(blockRefObj.InsertionPoint, "HBS-40A-RAUCHMELDER-ZWD", 1#, 1#, 1#, blockRefObj.Rotation)
        varAttributes2 = blockRefObj2.GetAttributes
        varAttributes2(0).TextString = varAttributes(0).TextString
        varAttributes2(1).TextString = varAttributes(1).TextString
        blockRefObj.Delete
        blockRefObj2.Update
    Else
        Exit Sub
    End If
GoTo RETRY
End Sub

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

---

tausch.gif

Hallo,

warum so kompliziert ? 

Du kannst einfach der Blockreferenz (Einfügung) den neuen Blocknamen zuweisen und fertig. Attributte und andere Eigenschaften bleiben erhalten.

Code:

---

  ' obj_ACAD_Grafikauswahl ist ein Selctionset mit SelectOnScreen
  For i = 0 To obj_ACAD_Grafikauswahl.Count - 1
  ' Einzelndes Enity zuweisen
  Set Entity = obj_ACAD_Grafikauswahl(i)
  Select Case Entity.EntityType
        Case acBlock
              ' Der Name des neuen Blocks
              Entity.Name = Me.Combo_Block2.Text
              Entity.Update
        case else
  end select
next i

---

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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