---

Hallo zusammen.

Ich fand folgenden etwas schwer zu diagonostizierenden Fehler. Mit dem Code:

Sub InsertErrorTest()
    Dim myBK As AcadBlockReference
    Dim Pt1(0 To 2) As Double
    Pt1(0) = 0: Pt1(1) = 0: Pt1(2) = 0
    Set myBK = ActiveDocument.ModelSpace.InsertBlock(Pt1, "C:\Kreis.dwg", 1#, 1#, 1#, 0)
End Sub

Füge ich einen Block in meine Zeichnung ein. Funktioniert wunderbar, kann natürlich auch mehrmals gedrückt werden, dann sind mehrere Kreise in meiner Zeichnung, alles soweit kein Problem.

So das Problem taucht aber auf, wenn ich das ganze in 2 unterschiedlichen Zeichnungen machen will. Mache ich nach dem einfügen des Kreises in Zeichnung1.dwg eine neue Zeichnung auf und versuche es dort wieder kommt es zum Dateifehler -2145386445 der ansonsten auch kommt, wenn der Pfad nicht stimmt.

Aber das ganze ist noch viel merkwürdiger. Ändere ich nun irgendetwas an meiner Funktion, selbst wenns nur eine Kommentarzeile ist, funktioniert das ganze wieder (ohne Änderung kommt immer nur die Fehlermeldung wieder).

Das bedeutet also, pro AutoCad Session kann ich die Funktion maximal für eine Zeichnung benutzen. Ich kann zwar einfach 10 mal die gleiche Funktion machen, und sicherstellen, dass er immer eine andere Funktion aufruft, das geht sogar, selbst wenn die Funktionen ident sind. Aber irgendwie wüsste ich schon lieber ob hier nicht irgendwie ressourcen hängen bleiben, freigegeben werden müssen oder was sonst falsch ist.

Danke im Voraus.

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

---

Hallo,

mit deiner Funktion fügst du ja auch eine Datei ein. Die wird dann in der zweiten Zeichnung noch geöffnet sein.

Wenn du es sauber lösen willst, fügst du die Datei einmal ein (z.B. über CopyObjects) und fügsts dann den Block aus der Zeichnung ein.

Wilfried Stelberg

PS: [EDIT]
Wer bist du denn jetzt  der oder der

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

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

---

Hallo Stelli1 ich bin irgendwie beide Nemorems, Autofill bei der Passworteingabe hat mich das wohl nicht bemerken lassen 

Ich dachte mir schon, dass es irgendwie noch geöffnet sein würde, auch wenn ich der Meinung bin, dass nach dem Einfügen einer Zeichnung als Block, die Zeichnung eigentlich nichts mehr mit dem Block zu tun haben müsste, genau wie ein WBlock auch.

Ich habe mir nun CopyObjects angesehen, mit dem aufgeführten Beispiel. Damit kann ich also Objekte in einer Zeichnung Klonen, aber ich verstehe jetzt leider gar nicht, wie ich damit Insertblock ablösen soll, wie du es vorschlägst  sdazu fällt mir nichts ein. Wäre dir dankbar wenn du das etwas genauer ausführen könntest...

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

---

moin,

versuch doch mal:

UnloadDVB "K:\ADT\ETC\ADT2008\vba\projekt.dvb"

oder wo auch immer deine DVB liegt, bei mir half das gaz gut.

Da es aber nervt beim debuggen die DVB ständig neu mit dem VBAMAN zu laden,
hab ich das dann noch an eine winzige Bedingung geknüpft:

If ThisDrawing.GetVariable("LOGINNAME") <> "Holger" Then
    UnloadDVB "K:\ADT\ETC\ADT2008\vba\projekt.dvb"
End If

Gruß
holger

[Diese Nachricht wurde von oscarr am 13. Mrz. 2008 editiert.]

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

---

Hallo,

hab ein Beispiel (gab es schon in einem Thread) mal um eine Funktion erweitert.

Code:

---

'' Ein formular anlegen
'' Eine Listbox (Listbox1)
'' Ein Button (CommandButton1)

Option Explicit
Private Sub CommandButton1_Click()
    Dim InsPkt(0 To 2) As Double
    Dim Spalte As Integer
    Dim Reihe As Integer
    Dim Blockref As AcadBlockReference
    Dim Blockdef As AcadBlock
   
    ' Ist der gewünschte Block schon in der Zeichnunf definiert ?
    Set Blockdef = GetBlockDef("Testblock")
    If Blockdef Is Nothing Then
        '' Block anlegen
        'Set Blockdef = CreateTestBlock
        '' Block aus einer Zeichnung laden
        Set Blockdef = LoadBlock("C:\Temp\Testblock.dwg")
        ' Listenfeld aktualisieren
        FillBlockList Me.ListBox1
    End If
   
    ' Ausgabe des Blocks
    For Spalte = 0 To 50 Step 2
        For Reihe = 0 To 50 Step 2
            InsPkt(0) = Spalte
            InsPkt(1) = Reihe
            Set Blockref = ThisDrawing.ModelSpace.InsertBlock(InsPkt, "Testblock", 1, 1, 1, 0)
            Blockref.color = Spalte + Reihe
            ' ==> Wenn ein Update durchgeführt wird werden die Blöcke sofort dargestellt
            '    sonst erst nach dem Schliessen der Form
            Blockref.Update
        Next Reihe
    Next Spalte
End Sub

Private Sub UserForm_Initialize()
    ' Listenfeld füllen
    FillBlockList Me.ListBox1
End Sub

Function FillBlockList(myListbox As Listbox) As Boolean
    ''
    '' Füllt die Blockliste in ein Listenfeld
    ''
    Dim Blockdef As AcadBlock
   
    myListbox.Clear
    For Each Blockdef In ThisDrawing.Blocks
        If Not Blockdef.IsLayout And Not Blockdef.IsXRef Then
            myListbox.AddItem Blockdef.Name
        End If
    Next
End Function
Function GetBlockDef(Blockname As String) As AcadBlock
    ''
    ''  Blockdefinition holen
    ''
    On Error Resume Next
    ' Versuch eine Blockdefinition zu holen
    Set GetBlockDef = ThisDrawing.Blocks(Blockname)
    If Err.Number Then
      ' Ist der Block nicht vorhanden
      Set GetBlockDef = Nothing
    End If
    On Error GoTo 0
End Function
Function CreateTestBlock() As AcadBlock
    ''
    '' Block erzeugen (Kreis mit Füllung)
    ''
    Dim Kreis(0) As AcadCircle
    Dim Füllung As AcadHatch
    Dim Pkt(0 To 2) As Double
   
    Set CreateTestBlock = ThisDrawing.Blocks.Add(Pkt, "Testblock")
    Set Kreis(0) = CreateTestBlock.AddCircle(Pkt, 1)
    Kreis(0).color = acByLayer
    Kreis(0).Update
    Set Füllung = CreateTestBlock.AddHatch(1, "SOLID", True)
    Füllung.AppendOuterLoop Kreis
    Füllung.Evaluate
    Füllung.color = acByBlock
    Füllung.Update
End Function
Function LoadBlock(vlst_DWG As String) As AcadBlock
    ''
    '' DWG als Block laden
    ''
    Dim tmpBlockRef As AcadBlockReference
    Dim tmpPkt(0 To 2) As Double
    Dim tmpBlockName As String
   
    ' Fügt eine DWG temporär ein
    Set tmpBlockRef = ThisDrawing.ModelSpace.InsertBlock(tmpPkt, vlst_DWG, 1, 1, 1, 0)
    ' Name des Block innerhalb von AutoCAD ermitteln
    tmpBlockName = tmpBlockRef.Name
    ' Blockreferenz löschen
    tmpBlockRef.Delete
    ' Rückgabe der Blockdefinition
    Set LoadBlock = ThisDrawing.Blocks(tmpBlockName)
End Function

---

Versuchs mal

Wilfried Stelberg

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

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

---

Funktioniert perfekt. Habs jetzt als Funktion und lade damit immer alle benötigten Blöcke für ein Modul am Anfang rein. Keine Probleme mehr, Danke!

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