I am attempting to use VBA in Acad 2007 to renumber a series of text objects based on their relative positions. (The text is numerals only.) The programs works well at first, but if I erase some of the text objects, it crashes. I noticed that if I start with 20 text objects in the drawing, and then erase 1, AutoCad reports 19 objects selected while ssetObj.Count is still equal to 20. Apparently the erased objects are still being returned by ssetObj.SelectOnScreen. To make sure I ran the example from a new drawing with only the text objects. Any ideas?
Solved! Go to Solution.
>> if I start with 20 text objects in the drawing, and then erase 1, AutoCad reports 19 objects selected
>> while ssetObj.Count is still equal to 20
When you delete an object it's not removed from the SelectionSet-collection, it's just marked as "deleted". If you have 20 plates and you crash one, you will also have 20 plates, ok, one of them is broken to peaces, but the counter gives "20".
So show us your code-snippet where you walk through your SelectionSet and we may give you inputs what may be your problem. Without seeing the code it's a lot of guessing (and not more not guessing).
- alfred -
Thanks for your reply. Just to be clear, the text objects are erased before the selection set is picked. I have noticed that if I save the drawing to disk, then close the drawing and reopen it, the problem goes away. I would like to be able to edit the text objects, save the drawing and then run the renumber routine. Here is all the code.
Global yin(2500), xin(2500) As Double Global handlein(2500) As String * 6 Global used(2500) As Boolean Global inin(2500) As Long Global csi%, cin& Global firstnumber$ Global frnu% Global thisy, thisx As Double Private Sub CommandButton2_Click() Dim ssetObj As AcadSelectionSet Dim oTxt As AcadText Dim FilterType(0) As Integer Dim FilterData(0) As Variant For i& = 0 To 2500 used(i) = False Next i& 'On Error Resume Next 'ssetObj.Clear 'On Error GoTo 0 On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Add("ss1") If Err.Number <> 0 Then Set ssetObj = ThisDrawing.SelectionSets.Item("ss1") End If On Error GoTo 0 UserForm1.Hide ' Return a point using a prompt returnPnt = ThisDrawing.Utility.GetPoint(, "Pick First Text Object (Must Snap to Insertion Point)") 'select text data FilterType(0) = 0 'Indicates filter refers to an object type FilterData(0) = "Text" 'Indicates the object type is "Line" 'Code from www.visiblevisual.com ssetObj.SelectOnScreen FilterType, FilterData If ssetObj.Count = 0 Then ssetObj.Delete MsgBox ("Nothing Selected") Exit Sub End If 'vectorize text insertion points cin& = 0 starty# = returnPnt(0): startx# = returnPnt(1) On Error GoTo skipit For i& = 0 To ssetObj.Count - 1 Set returnObj = ssetObj.Item(i&) If returnObj.ObjectName = "AcDbText" Then Set oTxt = returnObj v = oTxt.InsertionPoint yin(cin) = v(0): xin(cin) = v(1) handlein(cin) = oTxt.Handle cin& = cin& + 1 skipit: End If Next i& On Error GoTo 0 cin& = cin& - 1 cinin& = 0 'find start point in text insertion vector For i& = 0 To cin& If ((yin(i) = starty) And (xin(i) = startx)) Then 'found start point used(i) = True starti& = i inin(cinin&) = i cinin& = cinin& + 1 thisy = starty#: thisx# = startx# Exit For End If Next i& 'find next closest point countdown& = 1 Do inin(cinin) = findnext(thisy, thisx) cinin = cinin + 1 countdown& = countdown& + 1 Loop Until countdown > cin 'renumber text firstnumber$ = TextBoxFirstNumber.Text frnu = Val(firstnumber$) For i = 0 To cin ' Find an object from a given handle Set oTxt = ThisDrawing.HandleToObject(Trim(handlein(inin(i)))
) oTxt.TextString = firstnumber$ frnu = frnu + 1 firstnumber$ = Str(frnu) Next i TextBoxFirstNumber.Text = firstnumber$ UserForm1.Show End Sub Function findnext(thisy, thisx) As Long dmin# = 10000000 For j& = 0 To cin& If Not used(j) Then di# = Sqr((yin(j) - thisy) * (yin(j) - thisy) + (xin(j) - thisx) * (xin(j) - thisx)) If di < dmin Then dmin = di findnext = j End If End If Next j& used(findnext) = True thisy = yin(findnext): thisx = xin(findnext) End Function
Thank you again
imho you forgot the .Clear when using the selectionset a second time, so you have the previously selected objects in the selectionset.
Try to modify:
On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Add("ss1") If Err.Number <> 0 Then Set ssetObj = ThisDrawing.SelectionSets.Item("ss1") ssetObj.Clear End If
I have not tried your code, just read up to this point, let's see if it works now, if not let us know!.
- alfred -
I forgot to write in my original post that the error occurs trying to execute this statement
Set returnObj = ssetObj.Item(i&)
The error message is
Method 'Item' of object "IAcadSelectionSet' failed