Visual Basic Customization

[#1]

Hello

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?

Thank you

John

[#2]

Hi,

>> 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 -

[#3]

Hello

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

John

[#4 · Accepted solution]

Hi,

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 -

[#5]

Hello

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

Thank you

John

[#6]

Hello

That was the problem.  Works perfectly now.

Many thanks

John