---

Hallo,

ich habe ein VBA-Skript geschrieben das soweit auch funktioniert. Es werden einige 2D- und 3D-Objekte erzeugt. Das Problem ist: Die Erstellung startet nach einem Mausklick in einem Formular und die gezeichneten Objekte erscheinen erst wenn dieses Formular geschlossen wird. Gibt es eine Möglichkeit ein Neuzeichnen des Modelspace zur Laufzeit zu erzwingen? Ich habe eine entsprechende Funktion einfach nicht gefunden...

Lg doubleq

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

---

Hi doubleq,

Reicht vielleicht schon ein Zoom oder ein ThisDrawing.Regen True?!

Gruß, Carsten

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

---

Hallo,

in der Regel reicht die Methode UPDATE nach dem Erzeugen des Objektes.

Code:

---

    Set Blockref = ThisDrawing.ModelSpace.InsertBlock(InsPkt, "Blockname", 1, 1, 1, 0)
    Blockref.Update

---

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

---

Hallo,

Danke für Eure Antworten! Ich habe nun Eure Vorschläge ausprobiert - doch leider bleibt bei allen auch weiterhin der Modellbereich leer. Erst beim Schließen meiner Form werden die erstellten Objekte angezeigt.
Mache ich da möglicherweise was falsch? Oder gibt es noch Andere Wege ein Neuzeichnen zu erreichen?

Lg doubleq

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

---

Hallo,

dann hast du wahrscheinlich das Formular "modal" geöffnet. Wenn du es mit me.hide während des Einzeichnens ausblendest sollte es klappen.

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

---

ThisDrawing.Regen acActiveViewport
Das half bei mir was Blöcke betrifft
Update geht da zb auch nicht
Mfg Chris

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

---

Hallo,

bei werden die eingefügten Objekte sofort angezeigt wenn nach dem Einfügen ein Update darauf gemacht wird.

Ich hab mal ein Beispiel beigefügt.

Code:

---

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
   
    Set Blockdef = GetBlockDef("Testblock")
    If Blockdef Is Nothing Then
        Set Blockdef = CreateTestBlock
        FillBlockList Me.ListBox1
    End If
   
    For Spalte = 0 To 20 Step 2
        For Reihe = 0 To 20 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()
    FillBlockList Me.ListBox1
End Sub

Function FillBlockList(myListbox As Listbox) As Boolean
    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
    On Error Resume Next
    Set GetBlockDef = ThisDrawing.Blocks(Blockname)
    If Err.Number Then
      Set GetBlockDef = Nothing
    End If
    On Error GoTo 0
End Function
Function CreateTestBlock() As AcadBlock
    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

---

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

---

Hallo,

vielen Dank Euch allen für die Hinweise, Tipps und Infos! So langsam sehe ich wie ich meine Probleme lösen kann.

Liebe Grüße
doubleq

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