Point select program stuck in a loop..

[basepointdesignz]

Hi,

Could someone let me know why this might not be running properly:

What it's meant to do: Allow the user to select one or many points on a drawing, the program will insert a number block (incrementing each time a point is picked) and then break out of the loop when the user presses ENTER on the keyboard..

What it's actually doing: Not incrementing the attribute in the block, so stays at 1 every time and not breaking from the loop on anything, not even ESC or a forced error..

Below is the code for this part of the program, it worked for 2004 but not with 2007 or 2008, but i can't see anything wrong myself but you know the old expression 'can't see the woods for the trees' - after hours looking at it, it all looks like cling-on..

'***********************************************
' PICK POINTS....
'***********************************************
Private Sub selectcoordsBTN_Click()

On Error Resume Next
If Err.Number <> 0 Then
    MsgBox "The program has encountered an error and cannot be run at this time. Please try running it again..", vbCritical, "Pogram Error.."
    Exit Sub
    ThisDrawing.SendCommand " " & vbCr
Else
    'Do nothing and continue with the main program..
End If

ThisDrawing.ActiveSpace = acModelSpace 'Force drawing to modelspace..
countx = 1  'Set counter to nothing..
rowcount = 0
textYoffset = 0
countxx = countx * 3

xpointform.Hide  'Hide form to allow user to slect points from AutoCAD..

' Error Test for GetPoint method..
On Error Resume Next
TryAgain:
ptx = ThisDrawing.Utility.GetPoint(, vbCr & "Pick the first point (Press ENTER to finish).. ")  'Getpoint method..
'Set pointX = ThisDrawing.ModelSpace.AddPoint(ptx)  'Add an AcadPoint at each pickpoint, to show where the user has selected..
Set blkX = ThisDrawing.ModelSpace.InsertBlock(ptx, "X:\CAD_Tools\PCE\PointNum.dwg", 1#, 1#, 1#, 0)
blkX.Layer = "XPoints_bpd"
' Get Attribute values..
varAttributes = blkX.GetAttributes
' Edit the attribute text strings to show new coordinates..
varAttributes(0).TextString = countx

ErrHndlr:
    If Err.Number <> 0 Then
        If Err.Number = -2145320928 Then
            GoTo END_DO
        End If
        Err.Clear
        GoTo TryAgain
    End If
    On Error GoTo ErrHndlr
    
ReDim Preserve pointinfo(2, 0)
     
' Add data to the list box..
ptx(0) = ptx(0) / 1000
ptx(0) = Round(ptx(0), 3)
ptx(1) = ptx(1) / 1000
ptx(1) = Round(ptx(1), 3)
pointinfo(0, rowcount) = countx
pointinfo(1, rowcount) = ptx(0)
pointinfo(2, rowcount) = ptx(1)
ListBox1.Column() = pointinfo

'*******************************
'** Start the point pick loop **
'*******************************
Do
countx = countx + 1  'Add 1 to the counter..
countxx = countx * 3
rowcount = rowcount + 1

' Error Test for GetPoint method..
On Error Resume Next
TryAgain2:
ptx = ThisDrawing.Utility.GetPoint(, vbCr & "Pick the next point (Press ENTER to finish).. ")  'Getpoint method..
'Set pointX = ThisDrawing.ModelSpace.AddPoint(ptx)  'Add an AcadPoint at each pickpoint, to show where the user has selected..
Set blkX = ThisDrawing.ModelSpace.InsertBlock(ptx, "X:\CAD_Tools\PCE\PointNum.dwg", 1#, 1#, 1#, 0)
blkX.Layer = "XPoints_bpd"
' Get Attribute values..
varAttributes = blkX.GetAttributes
' Edit the attribute text strings to show new coordinates..
varAttributes(0).TextString = countx

ReDim Preserve pointinfo(2, countx - 1)

' Add data to the list box..
ptx(0) = ptx(0) / 1000
ptx(0) = Round(ptx(0), 3)
ptx(1) = ptx(1) / 1000
ptx(1) = Round(ptx(1), 3)
pointinfo(0, rowcount) = countx
pointinfo(1, rowcount) = ptx(0)
pointinfo(2, rowcount) = ptx(1)
ListBox1.Column() = pointinfo

ErrHndlr2:
    If Err.Number <> 0 Then
        If Err.Number = -2145320928 Then
            GoTo END_DO
        End If
        Err.Clear
        GoTo TryAgain
    End If
    On Error GoTo ErrHndlr2
    On Error GoTo END_DO 'Exit the loop if ENTER or another key is hit (basically an error)..
    
Loop
'*******************************
'******** End the loop *********
'*******************************

END_DO:
ReDim Preserve pointinfo(2, 0)
CheckBox1.Value = True
xpointform.Height = 348
xpointform.Show
End Sub
'***********************************************
' PICK POINTS....
'***********************************************

Any ideas?



Cheers,

Paul
basepointdesignzltd..
P4 3.0Ghz / 2GB RAM
XP Pro SP2
Sapphire X1950 512MB Dual-DVi Graphics Card..

 

[TCARPENTER]

Hi Paul,

I couldn't see anything wrong with it either, so I copied and pasted your code snippet into a quick and dirty form and had no problems with it other than getting through a few hurdles, I had to create your pointnum block, and I figured there is more code somewhere else. The only change I had to make was Dimensioning your
pointinfo variable:

Dim pointinfo()

I don't think this chunk you've posted is the issue. And I tested this on Architectural Desktop 2008.

HTH
Todd

 

[basepointdesignz]

Hey Todd,

Thanks for taking the time for this..

On extensive tests, i've narrowed down the problematic areas:

' Add data to the list box..
ptx(0) = ptx(0) / 1000
ptx(0) = Round(ptx(0), 3)
ptx(1) = ptx(1) / 1000
ptx(1) = Round(ptx(1), 3)
pointinfo(0, rowcount) = countx
pointinfo(1, rowcount) = ptx(0)
pointinfo(2, rowcount) = ptx(1)
ListBox1.Column() = pointinfo

I added a msgbox err.number & vbcr & err.description to check what was happening behind the scenes and it came up with a subscript out of range error, which as far as i can see is the:

pointinfo(0, rowcount) = countx
pointinfo(1, rowcount) = ptx(0)
pointinfo(2, rowcount) = ptx(1)

...section - as i can't see where i have set the rowcount variable (this code was written by me over 3 years ago and can't remember what i did and why - a lesson in good code commenting here methinks, lol)

So, as its encountering an error, it keeps going back to the start and when i pick a point it inserts the block and then the err and back again, so ofc ourse it won't get as far as the incremental attribute bit or the loop breaker..

I also commented out the above pointinfo bit and it error'd on the ListBox1.Column() = pointinfo saying it could set the column property or something. What could i be doing wrong here, not done a great deal with listbox's..

Funny thing is all this code worked perfectly on 2004, but not on 2007 or 2008..

Any ideas?


Cheers,

Paul
basepointdesignzltd..
P4 3.0Ghz / 2GB RAM
XP Pro SP2
Sapphire X1950 512MB Dual-DVi Graphics Card..

 

[TCARPENTER]

Hi Paul,

I think I may have figured at least some of it out. When I restarted AutoCAD, the routine blew up at the same place you're seeing. I think the problem is in your first ReDim statement. I changed it from:

ReDim Preserve pointinfo(2, 0)

To:

ReDim Preserve pointinfo(2, rowcount)

Then To:

ReDim Preserve pointinfo(2, countx-1)

The code didn't fail, but it did 3 of the same number before it would increment to the next, and then only two of the same number before it would increment after the second change.

As to your second question, with the listbox column, since you commented out the pointinfo portion, there was no column to set. When I run the routine, I would get the first column but not any others.

See if this little listbox column example from MicroSquash helps you out. Just create a userform with two list boxes in it, and then copy and paste this code into the Initialize section of the form:

Dim MyArray(6, 3)

Private Sub UserForm_Initialize()


    Dim i As Single
     'The 1st list box contains 3 data columns
    ListBox1.ColumnCount = 3
    'The 2nd box contains 6 data columns
     ListBox2.ColumnCount = 6

    'Load integer values into first column of MyArray
    For i = 0 To 5
        MyArray(i, 0) = i
    Next i

    'Load columns 2 and three of MyArray
    MyArray(0, 1) = "Zero"
    MyArray(1, 1) = "One"
    MyArray(2, 1) = "Two"
    MyArray(3, 1) = "Three"
    MyArray(4, 1) = "Four"
    MyArray(5, 1) = "Five"

    MyArray(0, 2) = "Zero"
    MyArray(1, 2) = "Un ou Une"
    MyArray(2, 2) = "Deux"
    MyArray(3, 2) = "Trois"
    MyArray(4, 2) = "Quatre"
    MyArray(5, 2) = "Cinq"

    'Load data into ListBox1 and ListBox2
    ListBox1.List() = MyArray
    ListBox2.Column() = MyArray


End Sub

HTH
Todd

 

[basepointdesignz]

Hey Todd,

Finally sorted it out, thank f***..

Had some of the code in the wrong order, ie: the error trap was before the redim statement and then the adding of the listbox should have been next or something like that, but anyway, all is now peaceful and great, lol..

Thanks for the input..

Cheers,

Paul
basepointdesignzltd..
P4 3.0Ghz / 2GB RAM
XP Pro SP2
Sapphire X1950 512MB Dual-DVi Graphics Card..