小女子跪求各位大虾

xinghesnak

那你就在点击时间末尾把三个text控件清空不就行了。。。何必非得卸载窗体呢。。。

dchlmz

试试下面的，应该没问题

Option Explicit
Private Type POINTAPI
x As Double
y As Double
z As Double
End Type
Dim p() As POINTAPI

 

 

Private Sub UserForm_Initialize()
ReDim p(0) As POINTAPI
End Sub

Private Sub CommandButton1_Click()
    ' 确保文本框的值不为空
    Dim item As MSForms.Control
    For Each item In UserForm1.Controls
        If TypeOf item Is TextBox Then
            If Len(item.Text) = 0 Then
                MsgBox "请输入定位点！", vbCritical
                Exit Sub
            End If
        End If
    Next item
   
    '存点
   If p(0).x <> 0 Then ReDim Preserve p(UBound(p) + 1)

   p(UBound(p)).x = Val(TextBox1.Text)
   p(UBound(p)).y = Val(TextBox2.Text)
   p(UBound(p)).z = Val(TextBox3.Text)

   TextBox1.Text = ""
   TextBox2.Text = ""
   TextBox3.Text = ""
 

End Sub

 

Private Sub CommandButton2_Click()
    ' 确保文本框的值不为空
    Dim item As MSForms.Control
    For Each item In UserForm1.Controls
        If TypeOf item Is TextBox Then
            If Len(item.Text) = 0 Then
                MsgBox "请输入定位点！", vbCritical
                Exit Sub
            End If
        End If
    Next item
   
    '存点
   If p(0).x <> 0 Then ReDim Preserve p(UBound(p) + 1)

   p(UBound(p)).x = Val(TextBox1.Text)
   p(UBound(p)).y = Val(TextBox2.Text)
   p(UBound(p)).z = Val(TextBox3.Text)
   
   
   
    ' 绘制直线
    Dim i As Integer
    Dim FormPnt(0 To 2) As Double
    Dim ToPnt(0 To 2) As Double
    For i = 1 To UBound(p)
        FormPnt(0) = p(i - 1).x
        FormPnt(1) = p(i - 1).y
        FormPnt(2) = p(i - 1).z
        ToPnt(0) = p(i).x
        ToPnt(1) = p(i).y
        ToPnt(2) = p(i).z
   
        ThisDrawing.ModelSpace.AddLine FormPnt, ToPnt
   
    Next
    End   '结束程序
End Sub

xinghesnak

其实你的程序总体是对的，要注意两点：

一。程序中这一段

For i = 2 To UBound(p)
        FormPnt(0) = p(i - 1).x
        FormPnt(1) = p(i - 1).y
        FormPnt(2) = p(i - 1).z
        ToPnt(0) = p(i).x
        ToPnt(1) = p(i).y
        ToPnt(2) = p(i).z
   
        ThisDrawing.ModelSpace.AddLine FormPnt, ToPnt
   
    Next

让人很费解，为什么i要从2开始递增呢？是不是你想连续画线，那就应该改成这样

For i = 1 To UBound(p) 
        FormPnt(0) = p(i －1).x
        FormPnt(1) = p(i －1).y
        FormPnt(2) = p(i －1).z
        ToPnt(0) = p(i).x
        ToPnt(1) = p(i).y
        ToPnt(2) = p(i).z
   
        ThisDrawing.ModelSpace.AddLine FormPnt, ToPnt
   
    Next

就是把2改成1就行了，哈哈！

二，我给你的这句话有问题

If p(0).x <> 0 Then ReDim Preserve p(UBound(p) + 1)

如果textbox1控件真的输入0，后面就画不出来了。再增加一个变量，判断是不是第一次输入数值（因为P（0）的xyz都有默认值0）是第一次，就直接

p(UBound(p)).x = Val(TextBox1.Text)
   p(UBound(p)).y = Val(TextBox2.Text)
   p(UBound(p)).z = Val(TextBox3.Text)

不是就先ReDim Preserve p(UBound(p) + 1)，这个改动很重要！

singlegu

呵呵,我的程序搞好了,谢谢各位大虾的帮忙

这是正确的程序,哪位新手想看也能参考

Option Explicit
Private Type POINTAPI
x As Double
y As Double
z As Double
End Type
Dim p() As POINTAPI

Private Sub UserForm_Initialize()
ReDim p(0) As POINTAPI
End Sub

Private Sub CommandButton1_Click()
    ' 确保文本框的值不为空
    Dim item As MSForms.Control
    For Each item In UserForm1.Controls
        If TypeOf item Is TextBox Then
            If Len(item.Text) = 0 Then
                MsgBox "请输入定位点！", vbCritical
                Exit Sub
            End If
        End If
    Next item
   
    TextBox1.SetFocus = 1
   
    '存点
  

   p(UBound(p)).x = Val(TextBox1.Text)
   p(UBound(p)).y = Val(TextBox2.Text)
   p(UBound(p)).z = Val(TextBox3.Text)
  
   ReDim Preserve p(UBound(p) + 1)

   TextBox1.Text = ""
   TextBox2.Text = ""
   TextBox3.Text = ""
  

End Sub

 

Private Sub CommandButton2_Click()
    ' 确保文本框的值不为空
    Dim item As MSForms.Control
    For Each item In UserForm1.Controls
        If TypeOf item Is TextBox Then
            If Len(item.Text) = 0 Then
                MsgBox "请输入定位点！", vbCritical
                Exit Sub
            End If
        End If
    Next item
   
   '存点
   p(UBound(p)).x = Val(TextBox1.Text)
   p(UBound(p)).y = Val(TextBox2.Text)
   p(UBound(p)).z = Val(TextBox3.Text)
   
       
    ' 绘制直线
   
    Dim i As Integer
    Dim FormPnt(0 To 2) As Double
    Dim ToPnt(0 To 2) As Double
    For i = 1 To UBound(p)
        FormPnt(0) = p(i - 1).x
        FormPnt(1) = p(i - 1).y
        FormPnt(2) = p(i - 1).z
        ToPnt(0) = p(i).x
        ToPnt(1) = p(i).y
        ToPnt(2) = p(i).z
   
        ThisDrawing.ModelSpace.AddLine FormPnt, ToPnt
   
    Next i
    End   '结束程序
End Sub

 

dance

xinghesnak发表于2006-5-8 15:32:00 看到最下面的那句 Private Sub Form_Load()ReDim PointData(0) As userDataEnd Sub 了吗？一定要写上，要不就下标越...

我在编一个求点集凸包的程序

采点集的程序部分已经搞定了但到了去极点部分就老提示下标越界

下面是我的程序：

Option Explicit
Private Type pointinfo
x As Single                    '点的x 坐标值
y As Single                    '点的y 坐标值
q As Single                    '与水平线的夹角
End Type
Dim p0 As pointinfo
Dim p(1 To 200) As pointinfo    '点集
Dim ps(1 To 200) As pointinfo    '排序后的点集
Dim pi(1 To 200) As pointinfo   '极点
Dim n, m, d As Integer
Dim x0, y0 As Single
Dim l, e As Integer

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
DrawWidth = 4
If n = 0 Then
 p0.x = x
 p0.y = y
 Circle (x, y), 100, RGB(255, 0, 255)
Else '输入点集
 p(n).x = x
 p(n).y = y
 Circle (x, y), 10, RGB(255, 255, 0)
End If
n = n + 1
x0 = x
y0 = y

End Sub

Private Sub Command2_Click()
Dim i As Integer
Dim q As Single
p(n).x = x0
p(n).y = y0
Const pi = 3.14
For i = l To n
If p(i).y - p0.y = 0 Then         （总是在这句提示下标越界）
        If p(i).x - p0.x = 0 Then
           p(i).q = 90
        ElseIf p(i).x - p0.x > 0 Then
          p(i).q = 180 / pi * Atn((p(i).y - p0.y) / (p(i).x - p0.x))
        Else
            p(i).q = 180 / pi * Atn((p(i).y - p0.y) / (p(i).x - p0.x)) + 180
        End If
ElseIf p(i).y - p0.y < 0 Then
        If p(i).x - p0.x = 0 Then
           p(i).q = 270
        ElseIf p(i).x - p0.x > 0 Then
          p(i).q = 360 + 180 / pi * Atn((p(i).y - p0.y) / (p(i).x - p0.x))
        Else
          p(i).q = 180 + 180 / pi * Atn((p(i).y - p0.y) / (p(i).x - p0.x))
        End If
End If
       
Next i

End Sub

xinghesnak

楼上的，你的数组下标定义的是1到200，而你的n是0，所以越界了。。定义你的数组时用

Dim p(0 To 200) As pointinfo  Dim ps(0 To 200) As pointinfo  Dim pi(0 To 200) As pointinfo

就行了。。

dance

xinghesnak发表于2006-5-13 8:31:00 楼上的，你的数组下标定义的是1到200，而你的n是0，所以越界了。。定义你的数组时用 Dim p(0 To 200) As pointinfo Dim ps(0 To ...

呵呵我是新手多谢指教！太感谢了！

但现在又出现新问题了。（注：我又把程序稍改了下，从p(0)开始记录点）

我想把点集中y最近小且距x最远的点找到，就用二分法排了序，但数组p（）的值纵传不到数组pl()上。请在帮忙看下：

Option Explicit
Private Type pointinfo
x As Single                    '点的x 坐标值
y As Single                    '点的y 坐标值
q As Single                    '与水平线的夹角
End Type
Dim p0 As pointinfo
Dim p(0 To 200) As pointinfo    '点集
Dim pl(0 To 200) As pointinfo   '求出起始点
Dim ps(0 To 200) As pointinfo   '排序后的点集
Dim pi(0 To 200) As pointinfo   '极点
Dim n, m, d As Integer
Dim x0, y0 As Single
Dim l, e As Integer

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
DrawWidth = 4
If n = 0 Then
 p(0).x = x
 p(0).y = y
 Circle (x, y), 100, RGB(255, 0, 255)
Else '输入点集
 p(n).x = x
 p(n).y = y
 Circle (x, y), 10, RGB(255, 255, 0)
End If
n = n + 1
x0 = x
y0 = y
 
End Sub

Private Sub Command2_Click()
Dim i As Integer
Dim q As Single
p(n).x = x0
p(n).y = y0
Const pi = 3.14
Dim u, j As Integer
Dim k, r, f As Integer
Dim term As pointinfo
For u = 0 To n
  term = p(l)
  k = 0
  r = u - 0
  Do While k <= r
           f = Int((k + r) / 2)
          If term.y < pl(f).y Or (term.y = pl(f).y And (Abs(term.x) > Abs(pl(f).x))) Then
             r = f - 1
          Else
             k = f + 1
          End If
  Loop
  For j = u - 1 To k Step -1
      pl(j + 1) = pl(j)
  Next j
  pl(k) = term
Next u

dance

大侠今天出门了?

有空时,请赐教

多谢

dance

dance发表于2006-5-14 22:24:00回复：（dance）大侠今天出门了? 大侠今天出门了? 有空时,请赐教 多谢

我重创个帖子