Hi all,
I am in the process of translating existing VBA code into VB.NET, and I just ran into some issues regarding how to interpret VBA's GOTO in VB.NET. In the VBA, the programmer has the code written thus...
Public Sub addTag()
Dim ptStart, ptEnd As Variant
Dim annotation As Object
Dim leader As AcadLeader
On Error Resume Next
StartAddTag:
' Pick start point
ptStart=ThisDrawing.Utility.GetPoint(, vbCrLf & "Select item to tag: ")
' Pick end point
ptEnd=ThisDrawing.Utility.GetPoint(ptStart, vbCrLf & "Select tag location: ")
Set annotation=ThisDrawing.ModelSpace.InsertBlock(ptEnd,"C:/tag.dwg",1,1,1,0)
' Add a leader to the drawing and set its annotation
Set leader=ThisDrawing.ModelSpace.AddLeader(ptStart,ptEnd,annotation,acLineWithArrow)
GoTo StartAddTag
End Sub
My VB.NET translation is thus...
Dim tbl As BlockTable
Dim mSpace As BlockTableRecord
Dim acTrans As Transaction
Dim db As Database
' Gets picked points from user
Private Function pickPoints() As Boolean
pickPoints = True
Dim res As PromptPointResult
Dim opts As PromptPointOptions = New PromptPointOptions("")
Dim acDoc As Document = acApp.DocumentManager.MdiActiveDocument
' Prompt for start point
opts.Message = vbLf & "Select item to tag: "
res = acDoc.Editor.GetPoint(opts)
ptStart = res.Value
' Exit if user presses ESC or cancels command
If res.Status = PromptStatus.Cancel Then
pickPoints = False
Exit Function
End If
' Prompt for end point
opts.Message = vbLf & "Select tag location: "
opts.UseBasePoint = True
opts.BasePoint = ptStart
res = acDoc.Editor.GetPoint(opts)
ptEnd = res.Value
' Exit if user presses ESC or cancels command
If res.Status = PromptStatus.Cancel Then
pickPoints = False
Exit Function
End If
End Function
' Sets the modelspace and block table
Private Sub setModelSpace()
tbl = acTrans.GetObject(db.BlockTableId, OpenMode.ForRead)
mSpace = acTrans.GetObject(tbl(BlockTableRecord.ModelSpace), _
OpenMode.ForWrite)
End Sub
' Adds a tag to modelspace, comprising of a leader with block annotation
Public Sub addTag()
While pickPoints()
acTrans = db.TransactionManager.StartTransaction()
Using acTrans
setModelSpace()
Dim blockId As ObjectId = insertTagBlock() ' works perfectly, adds the block
addLeader(getLeaderIntersect(), blockId) ' works perfectly, adds the leader
acTrans.Commit()
End Using
End While
End Sub
Without the while loop, single execution works perfectly. But the while loop to emulate multiple (recursive) execution raises some issues.
My problem occurs during execution of my VB.NET code, and has to do with display of the generated entities after the user picks points.
User picks the start point, then picks the end point, but nothing is displayed in the modelspace; rather, user is prompted immediately to pick start point and end point all over again (because of the while loop I used to emulate VBA's GOTO).
However, once user presses ESC, all the leaders and blocks that were drawn during the execution of the while loop are immediately displayed.
Is there a way for me to make it so that EACH time the while loop executes, the end product is IMMEDIATELY displayed in modelspace at the end of EACH loop, BEFORE the user is prompted to pick points all over again (beginning of the next loop)?
The VBA code executes as expected during runtime, as a result of the GOTO StartAddTag line of code.
But I can't use GOTO in my VB.NET code because of its messy nature, so I used a while loop instead. And the while loop isn't performing as expected. So, any suggestions?
Please feel free to request for additional information or clarification, if required.
Any help at all is greatly appreciated.
Thanks all...
Cat
Solved! Go to Solution.
Solved by Hallex. Go to Solution.
Hi,
First, I had to say this as nothing to do with recursion, this is a simple loop statement.
To mimic the autoCAD commands, you can exit the Sub if the user escapes (this aborts the transaction and rolls back any changes) or exit the while loop and go on executing the rest of the code (commit the transaction to save the changes).
To display the changes before the transaction is commited and disposed from within the While loop, you can call the Database.TransactionManager.QueueForGraphicFlush() method.
Here's a non tested example which may contains errors (VB is not at all my prefered language)
Public Sub AddTag() Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Dim opts As PromptPointOptions = New PromptPointOptions("") Dim res As PromptPointResult Using tr As Transaction = db.TransactionManager.StartTransaction() Dim mSpace As BlockTableRecord = _
DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord) ' Start a while loop until user pick start and end points While True ' Prompt for start point opts.Message = vbLf & "Select item to tag: " res = ed.GetPoint(opts) ' Exit sub if user presses ESC or cancels command If res.Status = PromptStatus.Cancel Then Exit Sub End If ' Break the while loop if user does not pick a point (Enter or right click) If res.Status <> PromptStatus.OK Then Exit While End If ptStart = res.Value ' Prompt for end point opts.Message = vbLf & "Select tag location: " opts.UseBasePoint = True opts.BasePoint = ptStart res = ed.GetPoint(opts) ' Exit if user presses ESC or cancels command If res.Status = PromptStatus.Cancel Then Exit Sub End If ' Break the while loop if user does not pick a point (Enter or right click) If res.Status <> PromptStatus.OK Then Exit While End If ptEnd = res.Value ' Add the block and the leader to Model Space Dim blockId As ObjectId = insertTagBlock() addLeader(getLeaderIntersect(), blockId) ' Force newly added objects to display db.TransactionManager.QueueForGraphicsFlush() End While tr.Commit() End Using
About recursion, basicaly a recursive method is a method which calls itself from within its own definition.
For example, using recursion is the only way to scan a tree structure you don't the nested depth.
Here's a simple example to get all DWG files in a directory and all the sub-directories.
Imperative way (filling a List(of String) passed as argument.
Sub GetAllDwgFiles(ByVal rootFolder As String, ByVal fileNames As List(Of String)) For Each file As String In Directory.GetFiles(rootFolder, "*.dwg") fileNames.Add(file) Next For Each dir As String In Directory.GetDirectories(rootFolder) GetAllDwgFiles(dir, fileNames) '<- recursive call Next End Sub
Or, in a more functional style (using Linq and returning an IEnumerable(Of string))
Function GetAllDwgFiles(ByVal rootFolder As String) As IEnumerable(Of String) Return _ Directory.GetFiles(rootFolder, "*.dwg") _ .Concat(Directory.GetDirectories(rootFolder).SelectMany(Function(dir) GetDwgFiles(dir))) End Function
Here is my 2 cents, though it is from my oldies and badly designed one:
Public Sub MultipleGetPoint(ByRef ok As Boolean, ByRef pts As List(Of Point3d)) ' credits to Kean Walmsley Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument Dim ed As Editor = doc.Editor pts = New List(Of Point3d) ok = False Try ' Prompt will be reused in our loop Dim ppo As New PromptPointOptions(vbLf & "Pick a point (or press Enter to Exit): ") ppo.AllowNone = True ' List of the points selected and our result object pts = New List(Of Point3d) Dim ppr As PromptPointResult ' The selection loop Do ' If we have a valid point selection, add it to the list ppr = ed.GetPoint(ppo) If ppr.Status = PromptStatus.OK Then pts.Add(ppr.Value) End If Loop While ppr.Status = PromptStatus.OK ' The loop will continue until a non-OK result... ' We only care if Enter was used to terminate 'Just to display a result: 'For Each p As Point3d In pts ' ed.WriteMessage(vbLf & "{0:f5}" & vbTab & "{1:f5}" & vbTab & "{2:f5}", p.X, p.Y, p.Z) 'Next If (pts.Count > 0) Then ok = True Else ok = False End If Catch ok = False Return End Try End Sub <CommandMethod("LPP", CommandFlags.UsePickSet)> _ Public Sub testLoop() Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Dim test As Boolean = False Dim points As New List(Of Point3d) doc.TransactionManager.EnableGraphicsFlush(True) Using tr As Transaction = db.TransactionManager.StartTransaction Do MultipleGetPoint(test, points) If Not test Then Exit Do End If Dim poly As Autodesk.AutoCAD.DatabaseServices.Polyline = New Autodesk.AutoCAD.DatabaseServices.Polyline() For Each pp As Point3d In points poly.AddVertexAt(0, New Point2d(pp.X, pp.Y), 0.0, 0.0, 0.0) Next For i As Integer = 0 To points.Count - 2 ed.DrawVector(points(i), points(i + 1), 3, False) Next Dim btr As BlockTableRecord = tr.GetObject(SymbolUtilityServices.GetBlockModelSpaceId(db), OpenMode.ForWrite) btr.AppendEntity(poly) tr.AddNewlyCreatedDBObject(poly, True) poly.ColorIndex = 1 tr.TransactionManager.QueueForGraphicsFlush() Loop doc.TransactionManager.FlushGraphics() tr.Commit() ed.Regen() End Using End Sub
I am overwhelmed with gratitude at the quick responses to this seemingly difficult problem of mine!
Gilles' code did the trick! And now I also learned something new, how to use the TransactionManager.QueueForGraphicsFlush() function
Thanks Gilles, thanks Hallex, your contributions are much appreciated.
Best regards,
Cat