小女子跪求各位大虾 - VBA/VB/ActiveX/API 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第3页

xinghesnak 发表于 2006-5-10 08:07:00

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

dchlmz 发表于 2006-5-10 08:26:00

试试下面的，应该没问题
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 发表于 2006-5-10 08:49:00

其实你的程序总体是对的，要注意两点：
一。程序中这一段
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 发表于 2006-5-10 16:41:00

呵呵,我的程序搞好了,谢谢各位大虾的帮忙
这是正确的程序,哪位新手想看也能参考
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 发表于 2006-5-12 22:20:00

[求助]能帮我也看看有什么问题吗

xinghesnak发表于2006-5-8 15:32:00static/image/common/back.gif
看到最下面的那句
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 发表于 2006-5-13 08:31:00

楼上的，你的数组下标定义的是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 发表于 2006-5-13 22:06:00

[求助]太感谢了

xinghesnak发表于2006-5-13 8:31:00static/image/common/back.gif
楼上的，你的数组下标定义的是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 发表于 2006-5-14 22:24:00

[求助]大侠今天出门了?

大侠今天出门了?
有空时,请赐教
多谢

dance 发表于 2006-5-14 22:29:00

[求助]

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

 我重创个帖子

页: 1 2 [3]

明经CAD社区's Archiver

[求助]能帮我也看看有什么问题吗

[求助]太感谢了

[求助]大侠今天出门了?

[求助]