×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Point select program stuck in a loop..

Point select program stuck in a loop..

Point select program stuck in a loop..

(OP)
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..



CODE

'***********************************************
' 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..

RE: Point select program stuck in a loop..

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:

CODE

Dim pointinfo()

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

HTH
Todd

RE: Point select program stuck in a loop..

(OP)
Hey Todd,

Thanks for taking the time for this..

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

CODE

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

RE: Point select program stuck in a loop..

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:

CODE

ReDim Preserve pointinfo(2, 0)
To:

CODE

ReDim Preserve pointinfo(2, rowcount)
Then To:

CODE

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:

CODE

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

RE: Point select program stuck in a loop..

(OP)
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..

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close