VBA 开发精彩实例教程中的 例子问题？

szwbluesky

<BR>ublic Function AddLine(ByVal ptSt As Variant, ByVal ptEn As Variant) As AcadLine<BR>                         <BR>                         Set AddLine = ThisDrawing.ModelSpace.AddLine(ptSt, ptEn)


End Function


Public Function AddLineXY(ByVal x1 As Double, ByVal y1 As Double, _<BR>                                                 ByVal x2 As Double, ByVal y2 As Double) As AcadLine<BR>                         <BR>                         '定义起点和终点<BR>                         Dim pt1(2) As Double<BR>                         Dim pt2(2) As Double<BR>                         <BR>                         '为点的坐标赋值<BR>                         pt1(0) = x1: pt1(1) = y1: pt1(2) = 0<BR>                         pt2(0) = x2: pt2(1) = y2: pt1(2) = 0<BR>                         <BR>                         Set AddLineXY = AddLine(pt1, pt2)<BR>End Function


Public Function AddLineReXY(ByVal ptSt As Variant, ByVal x As Double, _<BR>                                                 ByVal y As Double) As AcadLine<BR>                 <BR>                 '定义终点<BR>                         Dim ptEn As Variant<BR>                         ptEn = GetPoint(ptSt, x, y)


                         Set AddLineReXY = AddLine(ptSt, ptEn)<BR>End Function<BR>ublic Function AddLineReAL(ByVal ptSt As Variant, ByVal angle As Double, _<BR>                                                 ByVal length As Double) As AcadLine


                 '定义终点<BR>                         Dim ptEn As Variant<BR>                         peEn = GetPointAR(ptSt, angle, length)


                         Set AddLineReAL = AddLine(ptSt, ptEn)<BR>End Function<BR>ublic Sub TestLine()<BR>                         Dim ptSt(0 To 2) As Double<BR>                         Dim ptEn(0 To 2) As Double<BR>                         <BR>                         ptSt(0) = 100: ptSt(1) = 100: ptSt(2) = 0<BR>                         ptEn(0) = 150: ptEn(1) = 100: ptSt(2) = 0<BR>                         <BR>                         '(1)<BR>                         AddLine ptSt, ptEn<BR>                         '(2)<BR>                         AddLineXY 100, 120, 150, 120<BR>                         '(3)<BR>                         AddLineReXY ptSt, 50, 50<BR>                         '(4)<BR>                         'AddLineReAL ptSt, 3, 50<BR>                         <BR>End Sub<BR>


Windows2000,AutoCAD2002环境下，Function AddLineReXY和


Function AddLineReAL编译通不过，出现对话框，说：“编译错误：


子程序或函数未定义”，请高手指点一下。

mccad

GetPoint函数和GetPointAR函数你没有按照书中的要求输入。

szwbluesky

这是我的第一个程序，不好意思，水平有点洼。能不能说的详细一点，


我是照书上写的，和书上一样的，我的哪个错了，应该咋写呀？

mccad

在第38页中找找：
其中，GetPoint函数的输入参数是一点、另一点相对于该点在X和Y方向上的偏移量，计算另一点的坐标，其实现代码为：

2. Public Function GetPoint(pt As Variant, x As Double, y As Double) As Variant
3.        Dim ptTarget(0 To 2) As Double
4.        ptTarget(0) = pt(0) + x
5.        ptTarget(1) = pt(1) + y
6.        ptTarget(2) = 0
7.        GetPoint = ptTarget
8. End Function

Public Function GetPoint(pt As Variant, x As Double, y As Double) As Variant        Dim ptTarget(0 To 2) As Double        ptTarget(0) = pt(0) + x        ptTarget(1) = pt(1) + y        ptTarget(2) = 0        GetPoint = ptTarget End Function

还有：
其中，GetPointAR函数输入参数是一点、另一点相对于该点的极坐标值，求另一点的绝对坐标，实现代码为：

2. Public Function GetPointAR(ByVal ptBase As Variant, ByVal angle As Double, ByVal length As Double) As Variant
3.        Dim pt(0 To 2) As Double
4.        pt(0) = ptBase(0) + length * Cos(angle)
5.        pt(1) = ptBase(1) + length * Sin(angle)
6.        pt(2) = ptBase(2)
7.        GetPointAR = pt
8. End Function

Public Function GetPointAR(ByVal ptBase As Variant, ByVal angle As Double, ByVal length As Double) As Variant        Dim pt(0 To 2) As Double        pt(0) = ptBase(0) + length * Cos(angle)        pt(1) = ptBase(1) + length * Sin(angle)        pt(2) = ptBase(2)        GetPointAR = pt End Function

需要注意的是，上面的angle为弧度值。

szwbluesky

哦，它是需要将这两个函数也创建，真是太感谢你了。可不可


以要你的QQ号啊，经后有问题在麻烦你。


还有，有没有关于AutoCAD的QQ群？