AutoCAD VBA中AddLine函数坐标运算报错问题求助

问题描述 #

我能正常创建直线，但为了提升效率，想通过给x或y坐标添加额外值的方式复用相似点生成直线。line1通过单独变量赋值的方式可正常运行，但生成数百条直线时该方式过于繁琐，因此更倾向于testline的写法。然而testline会触发「无效过程调用或参数，运行时错误5」的报错，即使测试固定坐标的AddLine写法也会出现同样问题。

原始代码 #

Dim basePnt As Variant
basePnt = ThisDrawing.Utility.GetPoint(, "select base")

Dim topdoorpoint As Variant
topdoorpoint = basePnt

Dim displacepoint As Variant
displacepoint = basePnt
displacepoint(1) = displacepoint(1) + DOORHEIGHT ' Shift up by fullheight of doorheight, y coordinate

'line1 works great
Dim line1 As AcadLine
Set line1 = ThisDrawing.ModelSpace.AddLine(displacepoint, topdoorpoint)

'testline revieves error;invalid procedure call or argument, run time error "5"
Set testline = ThisDrawing.ModelSpace.AddLine(basePnt, Array(basePnt(0), basePnt(1) + DOORHEIGHT, basePnt(2)))

问题原因 #

AutoCAD的AddLine方法要求传入的点参数必须是双精度(Double)类型的数组，而VBA原生的Array()函数返回的是Variant类型的一维数组，类型不匹配导致了运行时错误5。

解决方法 #

方法1：直接创建Double类型数组（单次使用推荐） #

手动声明一个Double类型的三维数组，赋值后传入AddLine：

Dim basePnt As Variant
basePnt = ThisDrawing.Utility.GetPoint(, "select base")

' 生成目标点的Double数组
Dim endPnt(2) As Double
endPnt(0) = basePnt(0)
endPnt(1) = basePnt(1) + DOORHEIGHT
endPnt(2) = basePnt(2)

' 正常创建直线
Dim testline As AcadLine
Set testline = ThisDrawing.ModelSpace.AddLine(basePnt, endPnt)

方法2：封装点生成函数（多次使用推荐） #

如果需要频繁生成这类偏移点，可以封装一个返回Double数组的函数，简化代码：

' 封装生成三维点Double数组的函数
Function CreatePoint(x As Double, y As Double, z As Double) As Double()
    Dim pnt(2) As Double
    pnt(0) = x
    pnt(1) = y
    pnt(2) = z
    CreatePoint = pnt
End Function

' 主代码调用
Dim basePnt As Variant
basePnt = ThisDrawing.Utility.GetPoint(, "select base")

Dim testline As AcadLine
Set testline = ThisDrawing.ModelSpace.AddLine(basePnt, CreatePoint(basePnt(0), basePnt(1) + DOORHEIGHT, basePnt(2)))

补充说明 #

line1能正常运行的原因是：basePnt通过GetPoint获取，返回的本身就是Double类型的数组，后续赋值给displacepoint后修改的也是Double数组内的值，完全符合AddLine的参数要求。

内容的提问来源于stack exchange，提问作者vadim