标题: 可否帮个大忙把下面的VBA代码转成VB代码 [打印本页] 作者: 途若梦行 时间: 2006-12-7 15:01 标题: 可否帮个大忙把下面的VBA代码转成VB代码 如下面代码可否有人帮下忙转成Visual Basic代码,先谢了, Thanks a lot
---------------------------------------------------------------------------------------------------------------------------------------------
Public pt As Double
Public X, Y, Z As Double
Public f1 As Double
Public point1 As Variant
Public point2 As Variant
Public point3 As Variant
Public pi As Double
Private Sub cmdPickPt_Click()
UserForm16.Hide
point1 = ThisDrawing.Utility.GetPoint(, "请指定宽度上的第一个点:")
point2 = ThisDrawing.Utility.GetPoint(point1, "请指定宽度上的第二个点:")
point3 = ThisDrawing.Utility.GetPoint(point1, "请指定高度的上第三个点：")
X = point1(0)
Y = point1(1)
Z = 0
f = point1(1)
pt = point2(0) - point1(0)
f1 = point3(1) - point1(1)
UserForm16.TextBox1.text = Str(Round(pt, 4))
UserForm16.TextBox2.text = Str(Round(f1, 4))
UserForm16.Show
End Sub
Private Sub CommandButton1_Click()
UserForm16.Hide
If UserForm16.TextBox1.text = "" Or UserForm16.TextBox2.text = "" Then
MsgBox "输入的数据不全请重新输入(长宽数据不有指定)"
UserForm16.Show
End If
If CDbl(UserForm16.TextBox1.text) < 0 Or CDbl(UserForm16.TextBox2.text) < 0 Then
MsgBox "对不起，你输入的数据有错误(取点方向与顺序不对，请遵从从左到右，从下到上的取点顺序)"
UserForm16.Show
End If
pi = 3.14159
Dim pointsize_bujin, mindistance_bujin, matrix_x_bujin, matrix_y_bujin As Double '定义窗体中变量的步进变量
pointsize_bujin = CDbl(UserForm16.TextBox11.text)
mindistance_bujin = CDbl(UserForm16.TextBox10.text)
matrix_x_bujin = CDbl(UserForm16.TextBox7.text)
matrix_y_bujin = CDbl(UserForm16.TextBox8.text)
Dim sum_number As Integer '定义变量，表示总的区域数量
sum_number = Int(UserForm16.TextBox9.text)
Dim sum, arve, number_points As Double '定义变量来计算部反射面积，和点的个数
sum = 0
number_points = 0
arve = pi * ((pointsize / 2) * (pointsize / 2))
Dim number_x, number_y, temp_number_x As Integer '定义变量，用来判断 X Y 方向的点的个数
number_x = pt / matrix_x
temp_number_x = pt / matrix_x
number_y = f1 / matrix_y
'以下几句用来计算纵方向的个数是否为整数，若不是的话，加1
If (f1 * 1000) Mod (matrix_y * 1000) <> 0 Then
number_y = number_y + 1
End If
Dim i, j, k, l As Integer '定义循环变量
i = 1
j = 1
k = -1
Dim zuobiao_x, zuobiao_y, zuobiao As Double '定义变量，用来在程序中计算点的步进值
zuobiao_x = point1(0)
zuobiao_y = point1(1)
Dim location(0 To 2) As Double
location(0) = X
location(1) = Y
location(2) = 0
Dim pointObj As AcadCircle
For l = 1 To sum_number
For j = 1 To number_y
For i = 1 To number_x
zuobiao_x = ((matrix_x - mindistance - pointsize / 2) - (mindistance + pointsize / 2)) * Rnd
zuobiao_y = ((matrix_y - mindistance - pointsize / 2) - (mindistance + pointsize / 2)) * Rnd
zuobiao = zuobiao_x + mindistance + pointsize / 2
location(0) = location(0) + zuobiao
zuobiao = zuobiao_y + mindistance + pointsize / 2
location(1) = location(1) + zuobiao
Set pointObj = ThisDrawing.ModelSpace.AddCircle(location, pointsize / 2)
sum = sum + arve
number_points = number_points + 1
X = X + matrix_x
location(0) = X
location(1) = point1(1)
Next
Y = Y + matrix_y
point1(1) = Y
location(1) = point1(1)
point1(0) = point1(0) - matrix_x / 2 * k
location(0) = point1(0)
X = point1(0)
If k = -1 Then
number_x = temp_number_x - 1
Else
number_x = temp_number_x
End If
k = k * -1
Next
Y = Y - matrix_y
matrix_x = matrix_x + matrix_x_bujin
number_x = pt / matrix_x
temp_number_x = pt / matrix_x
matrix_y = matrix_y + matrix_y_bujin
number_y = f1 / matrix_y
'以下几句用来计算纵方向的个数是否为整数，若不是的话，加1
If (f1 * 1000) Mod (matrix_y * 1000) <> 0 Then
number_y = number_y + 1
End If
mindistance = mindistance + mindistance_bujin
pointsize = pointsize - pointsize_bujin
arve = pi * ((pointsize / 2) * (pointsize / 2))
zuobiao_x = point1(0)
Y = Y + matrix_y
point1(1) = Y
location(1) = point1(1)
Next
'标注文字
Dim addtext As AcadText
Dim textpoint As Variant
textpoint = point2
textpoint(0) = textpoint(0) + 10
Set addtext = ThisDrawing.ModelSpace.addtext("1：" & "点的大小是:" & UserForm16.TextBox3.text, textpoint, 2)
textpoint(1) = textpoint(1) + 4
Set addtext = ThisDrawing.ModelSpace.addtext("2：" & "点与点之间的最小间隙是:" & UserForm16.TextBox4.text, textpoint, 2)
textpoint(1) = textpoint(1) + 4
Set addtext = ThisDrawing.ModelSpace.addtext("3：" & "矩阵X方各的间距是:" & UserForm16.TextBox5.text, textpoint, 2)
textpoint(1) = textpoint(1) + 4
Set addtext = ThisDrawing.ModelSpace.addtext("4：" & "矩阵Y方向的间距是:" & UserForm16.TextBox6.text, textpoint, 2)
textpoint(1) = textpoint(1) + 4
Set addtext = ThisDrawing.ModelSpace.addtext("5：" & "全部点的反射面积是:" & Str(left(sum, 7)), textpoint, 2)
textpoint(1) = textpoint(1) + 4
Set addtext = ThisDrawing.ModelSpace.addtext("6：" & "点的个数是:" & Int(number_points), textpoint, 2)
End
End Sub
Private Sub CommandButton2_Click()
UserForm16.Hide
UserForm14.Show
End Sub
