.NET
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Display inserted blocks while inside a loop

7 REPLIES 7
SOLVED
Reply
Message 1 of 8
laurie.comerford
1104 Views, 7 Replies

Display inserted blocks while inside a loop

Hi,

 

I am asking the user to select points and insert a block at each of the selected points. On user exit from the point selection I draw a polyline connecting the blocks.

 

However, I cannot get the already inserted blocks to display until I complete the insertion of all blocks.  How do I go about getting them to display as soon as they are inserted?

' The code segment below is inside a transaction and nothing appears on the screen till this transaction is committed
' Pt(0 to 2) is defined as a double and is returned when the user selects a point with function SelectPoint Do While SelectPoint(Pt) = True Dim MyPoint3D As New Point3d(Pt(0), Pt(1), Pt(2)) InsertBlockAtPoint(MyPoint3D, myTransManager, strBID, _ myBlockTable, CurrentBlockSpace, dwg, True) ' strBID is a previously populated structure containing data about the block insertion details and Xdata to be added to the block reference Dim MyPolyPoint3D As New Point3d(Pt(0), Pt(1), 0) myPoints.Add(MyPolyPoint3D) ' myPoints is a data set used to plot the polyline Loop ''''''''' Function InsertBlockAtPoint(ByVal pMyPoint3D As Point3d, ByVal pMyTransMan As DatabaseServices.TransactionManager, ByVal strBID() As FormMain.BlockInsertionData, _ ByVal pmyBlockTable As BlockTable, ByVal pCurrentBlockSpace As BlockTableRecord, ByVal dDwg As Database, Optional ByVal bpShowBlockQuickly As Boolean = False) As Boolean Dim myDwg As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument Dim dwg As Database = myDwg.Database 'Dim myTransMan As DatabaseServices.TransactionManager 'myTransMan = myDwg.TransactionManager Dim myBlockTrans As Transaction myBlockTrans = pMyTransMan.StartTransaction ' myBlockTrans = myTransMan.StartTransaction Try Dim i As Integer = 0 'Dim CurrentBlockSpace As BlockTableRecord = myBlockTrans.GetObject(dwg.CurrentSpaceId, OpenMode.ForWrite) ''add block reference to the current space Dim sBlockName As String = strBID(i).sBlockName Dim BlockRef As BlockReference = New BlockReference(pMyPoint3D, pmyBlockTable.Item(sBlockName)) BlockRef.Layer = strBID(i).sLayer Dim Scale As Scale3d = New Scale3d(strBID(i).dX, strBID(i).dY, strBID(i).dZ) BlockRef.ScaleFactors = Scale <snip code for adding Xdata as this is irrelevant> pCurrentBlockSpace.AppendEntity(BlockRef) 'add the block reference to the current space myBlockTrans.AddNewlyCreatedDBObject(BlockRef, True) myBlockTrans.Commit() Return True Catch ex As Exception MsgBox("Unable to insert block with Function 'InsertBlockAtPoint' due to:" & vbCrLf & Err.Description) Return False Finally myBlockTrans.Dispose() ' myTransMan.Dispose() ' I had hoped the UpdateScreen below would work, but for me it doesn't, nor does the SendStringToExecute If bpShowBlockQuickly = True Then Autodesk.AutoCAD.ApplicationServices.Application.UpdateScreen() 'Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.SendStringToExecute("._Refresh", True, True, False) End If End Try End Function ' InsertBlockAtPoint

 

 

Regards

Laurie Comerford
7 REPLIES 7
Message 2 of 8

Hi,

 

my first try would be:

Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Regen()

...and if that does not help, there is a function FlushGraphics (havong not at my hands at the moment, but ARX-docu should give help, I hope).

 

HTH, - alfred -

------------------------------------------------------------------------------------
Alfred NESWADBA
Ingenieur Studio HOLLAUS ... www.hollaus.at ... blog.hollaus.at ... CDay 2024
------------------------------------------------------------------------------------
(not an Autodesk consultant)
Message 3 of 8

Hi Alfred,

 

Thanks for the that suggestion.  It seems entirely logical, but for me it's stil not working.

 

I'm wondering if my Video card is inadequate.  It's an NVIDIA GTS 250 which doesn't seem to be Autodesk OK.

 

 

Regards,

 

Laurie Comerford

Regards

Laurie Comerford
Message 4 of 8

I have not tested this, so no promises, but try:

 

MyBlockTrans.Commit()

pMyTransMan.QueueForGraphicsFlush()

Return True

...

...

If bpShowBlockQuickly then

    myDwg.TransactionManager.FlushGraphics()

End If

 

You may need a call to myDwg.TransactionManager.EnableGraphicsFlush(True), but I think that is the default, as the ARX docs indicate you should be careful with setting it to false.

Dave O.                                                                  Sig-Logos32.png
Message 5 of 8

Hi,

 

maybe I'm to late now, I have this code (calling loop with insert in a sub) plus a version that at least works on my laptop-configuration (also not the best for AutoCAD) and as long as AutoCAD does not stopping refreshing you see more and more blocks inserted.

You can see that on the attached video (where the screengraber has some troubles to get the refresh 😉 ) and you can also see on the end a "maybe-problem". In my opinion when a command uses much of the graphiccard AutoCAD stops refreshing it. For example when you create a loop writing messages to the command-area, then set focus to any other application, the lines in the command-area will stop sometimes. I have not figured out, what I can do against this (except of setting the focus back to AutoCAD ... well ... user will hate me when they want to work in Excel while AutoCAD is busy), so I won't do that 😉

 

Within the look I have some statements you can also try to get objects displayed during runtime.

   Public Shared Sub ADESK_insertBlockAndDisplayRefresh()
      Dim tRadius As Double = 100
      Dim tCenter As Point3d = Point3d.Origin
      Dim tBlockName As String = "TESTBLK"         'must be defined in current drawing

      Dim tAcadDoc As Document = Application.DocumentManager.MdiActiveDocument
      Dim tDocLock As DocumentLock = Nothing
      Dim tTrAct As Transaction = Nothing

      Try
         tDocLock = tAcadDoc.LockDocument
         tTrAct = tAcadDoc.TransactionManager.StartTransaction

         'get blocktable
         Dim tBlTab As BlockTable = CType(tTrAct.GetObject(tAcadDoc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
         'get blocktablerecord-id of block to insert
         Dim tBlTabRecID As ObjectId = tBlTab(tBlockName)   'WARNING !!! be carefull that the id is valid and not erased !!!

         tTrAct.Dispose() : tTrAct = Nothing

         'now draw blockrefs around a circle
         For tAng As Double = 0 To Math.PI * 2 Step Math.PI / 360.0
            Dim tPnt As Point3d = tCenter + New Vector3d(tRadius * Math.Sin(tAng), tRadius * Math.Cos(tAng), 0.0)
            Call InsertBlockAtPoint(tAcadDoc, tPnt, tBlTabRecID, tAcadDoc.Database.CurrentSpaceId, True)
            'tAcadDoc.Editor.WriteMessage(vbNewLine & (tAng * 180 / Math.PI).ToString & " Angle filled")
            'Threading.Thread.Sleep(100)  'give time to display
         Next

         Debug.Print("")

      Catch ex As Exception
         Call MsgBox("Error occured in ''!" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
      Finally
         If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
         If tDocLock IsNot Nothing Then tDocLock.Dispose() : tDocLock = Nothing
      End Try

   End Sub

   ''' <summary>InsertBlockAtPoint inserts a BlockReference</summary>
   ''' <param name="AcadDoc">Document where to work</param>
   ''' <param name="pMyPoint3D">Insertion Point (WCS)</param>
   ''' <param name="BlToInsertID">BlockTable(ObjectID) for creating the BlockReference</param>
   ''' <param name="currentSpaceID">Space(ObjectID) to insert the BlockReference</param>
   ''' <param name="bpShowBlockQuickly">show creation realtime</param>
   ''' <returns>TRUE of OK, otherwise FALSE</returns>
   ''' <remarks></remarks>
   Public Shared Function InsertBlockAtPoint(ByRef AcadDoc As Document, ByVal pMyPoint3D As Point3d, ByVal BlToInsertID As ObjectId, ByVal currentSpaceID As ObjectId, Optional ByVal bpShowBlockQuickly As Boolean = False) As Boolean
      Dim tRetVal As Boolean = False

      Dim tAcadDocDB As Database = AcadDoc.Database
      Dim tTrAct As Transaction = Nothing

      Try
         tTrAct = tAcadDocDB.TransactionManager.StartTransaction
         'get current space (where blockrefs are to be created) ... ModelSpace or any PaperSpace or (in Blockeditor) the BlockTableRecord of the Blockdefinition
         Dim tCurrSp As BlockTableRecord = CType(tTrAct.GetObject(currentSpaceID, OpenMode.ForWrite), BlockTableRecord)
         'create BlockRef
         Dim BlockRef As BlockReference = New BlockReference(pMyPoint3D, BlToInsertID)
         BlockRef.Layer = "0"
         BlockRef.ScaleFactors = New Scale3d(1, 1, 1)

         'add to current Space
         tCurrSp.AppendEntity(BlockRef)
         tTrAct.AddNewlyCreatedDBObject(BlockRef, True)
         'BlockRef.Draw()
         tTrAct.Commit() : tTrAct.Dispose() : tTrAct = Nothing

         tRetVal = (BlockRef IsNot Nothing) 'just to make sure

      Catch ex As Exception
         MsgBox("Unable to insert block with Function 'InsertBlockAtPoint' due to:" & vbCrLf & Err.Description)
      Finally
         ' I had hoped the UpdateScreen below would work, but for me it doesn't,  nor does the SendStringToExecute
         If tRetVal AndAlso (bpShowBlockQuickly = True) Then
            'AcadDoc.TransactionManager.FlushGraphics()
            AcadDoc.Editor.Regen()
            'AcadDoc.Editor.UpdateScreen()
            'Autodesk.AutoCAD.ApplicationServices.Application.UpdateScreen()
         End If
         If (tTrAct IsNot Nothing) Then
            If Not tTrAct.IsDisposed Then tTrAct.Dispose()
            tTrAct = Nothing
         End If
      End Try
      Return tRetVal
   End Function

 

HTH, - alfred -

------------------------------------------------------------------------------------
Alfred NESWADBA
Ingenieur Studio HOLLAUS ... www.hollaus.at ... blog.hollaus.at ... CDay 2024
------------------------------------------------------------------------------------
(not an Autodesk consultant)
Message 6 of 8

Ok, I tested my suggestion and it worked for me, without calling EnableGraphicsFlush(True).

 

As a matter of fact, it seems that simply calling QueueForGraphicsFlush is all that is necessary, don't seem to need the call to FlushGraphics, which is a good thing, because the FlushGraphics call comes from a different TransactionManager from the ApplicationServices namespace, instead of the usual one from the DatabaseServices namespace.

Dave O.                                                                  Sig-Logos32.png
Message 7 of 8

Hi Chiefbraincloud,

 

You are spot on with this as far as I can see.  I'm almost back to my VBA original functionality now.

 

  If bpShowBlockQuickly = True Then
                pMyTransMan.QueueForGraphicsFlush()
  End If
' The above works
' The items below are the options with which I'd tried and failed
                ' myDwg.TransactionManager.FlushGraphics()
                ' Autodesk.AutoCAD.ApplicationServices.Application.UpdateScreen() ' Doesn't work
                ' Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.UpdateScreen()
                ' Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Regen()

                ' Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.SendStringToExecute("._Refresh", True, True, False)
           

 Thanks,

 

Laurie Comerford

Regards

Laurie Comerford
Message 8 of 8
Hallex
in reply to: laurie.comerford

Hi,

Try this code instead

(tested on A2009 only)

#Region "Imports"
Imports System
Imports System.Text
Imports System.IO
Imports System.Data
Imports System.Reflection
Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions<
Imports System.Threading
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports acApp = Autodesk.AutoCAD.ApplicationServices.Application
#End Region
'_____________________________________
#Region "Insert Block And Refresh Screen"
Public Sub ADESK_insertBlockAndDisplayRefresh()
Dim rad As Double = 100
Dim pnt As Point3d = Point3d.Origin
Dim bname As String = "TESTBLK" 'must be defined in current drawing
Dim doc As Document = acApp.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Using docloc As DocumentLock = doc.LockDocument
Using tr As Transaction = doc.TransactionManager.StartTransaction
Try 'get blocktable
Dim bt As BlockTable = TryCast(doc.Database.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
If bt Is Nothing Then ed.WriteMessage(vbNewLine & "Problem with BlockTable")
Return End If If Not bt.Has(bname) Then
ed.WriteMessage(vbNewLine & "Block does not exist")
Return End If Dim id As ObjectId = bt(bname)
If id.IsErased Or Not id.IsValid Then
ed.WriteMessage(vbNewLine & "Block is not valid or erased")
Return
End If 'now draw blockrefs around a circle
For ang As Double = 0 To Math.PI * 2 Step Math.PI / 15
Dim tPnt As Point3d = pnt + New Vector3d(rad * Math.Sin(ang), rad * Math.Cos(ang), 0.0)
InsertBlockNoCommit(doc, tPnt, id, doc.Database.CurrentSpaceId, True)

doc.TransactionManager.QueueForGraphicsFlush()
doc.TransactionManager.FlushGraphics()
ed.UpdateScreen()


Threading.Thread.Sleep(100) 'to delay 0.1 sec
Next tr.Commit()
Catch ex As System.Exception
ed.WriteMessage(vbNewLine & ex.StackTrace)
Finally
End Try
End Using
End Using
End Sub
Public Shared Function InsertBlockNoCommit(ByRef doc As Document, ByVal inspt As Point3d, ByVal id As ObjectId, _
ByVal currentSpaceID As ObjectId, Optional ByVal bpShowBlockQuickly As Boolean = False) As Boolean
Dim tRetVal As Boolean = True
Using tr As Transaction = doc.TransactionManager.TopTransaction
Try Dim btr As BlockTableRecord = CType(tr.GetObject(currentSpaceID, OpenMode.ForWrite), BlockTableRecord)
Dim bref As BlockReference = New BlockReference(inspt, id)
With bref
.Layer = "0"
.ScaleFactors = New Scale3d(1, 1, 1)
End With
btr.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
Catch ex As System.Exception
tRetVal = False
MsgBox("Unable to insert block with Function 'InsertBlockNoCommit' due to:" & vbNewLine & ex.StackTrace)
Finally
End Try
End Using
Return tRetVal
End Function
#End Region

__________________________________________________________________

"The whole problem with the world is that fools and fanatics are always

so certain of themselves, and wiser people so full of doubts."

Bertrand Russell

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk DevCon in Munich May 28-29th


Autodesk Design & Make Report

”Boost