CAD中VBA操作多段线画矩形

VBA操作多段线画矩形

在CAD中使用VBA画多段线闭合的矩形。其实这个多段线围起来，围成一个矩形即可。

VBA中多段线是一串点，每个点使用两个双精度数值描述，这些数值连续放在数组中，就用ThisDrawing.ModelSpace.AddLightWeightPolyline(数组名)命令画出一段多段线。画出矩形，关键就是要控制好四个顶点。

本次测试中使用一条直线（用于定矩形的方向的基准线）为参数画出一个矩形。如果希望控制矩形的宽度，也可以再加其他控制条件。

提示用户画矩形，选取第一个点（sp，这里的点其实是一个只有两个元素的数组）

提示用户画矩形，选取第

二个点（ep）

由两点算这条基准线的长

度l、角度正弦sina和角度余

弦cosa

l=sqr((sp(1)-ep(1))^2+

(sp(0)-ep(0)^2))

sina=(ep(1)-sp(1))/l

cosa=(ep(0)-sp(0))/l

由此可知，第三点坐标p3（ep（0）+w*(-sina),ep(1)+w*cosa）

进而推得第四点p4（p3(0)+(-cosa)*l,p3(1)+(-sina)*l）

最后还要连回第一点，古增加一个p5，和sp同一点。

于是这个数组组建完毕，总共是个数值，每两个数值对应一个点，总共五个点。代码实现如下：

Sub Rectang()

On Error GoTo ESC

sp = ThisDrawing.Utility.GetPoint(, "起点:")

ep = ThisDrawing.Utility.GetPoint(sp, "终点：")

l = Sqr((sp(1) - ep(1)) ^ 2 + (sp(0) - ep(0)) ^ 2)

sina = -(sp(1) - ep(1)) / d

cosa = -(sp(0) - ep(0)) / d

Dim p(1 To 10) As Double ’用来放多段线点数组

p(1) = sp(0)

p(2) = sp(1) ‘第一点

p(3) = p(1) + sl * cosa

p(4) = p(2) + sl * sina ‘第二点

p(5) = p(3) + sw * -sina

p(6) = p(4) + sw * (cosa) ‘第三点

p(7) = p(5) + sl * (-cosa)

p(8) = p(6) + sl * (-sina) ‘第四点

p(9) = p(1)

p(10) = p(2)‘第五点

Dim rect(0 To 0) As AcadEntity

Set rect(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(p)

ESC:

If Err Then MsgBox Err.Description, vbOKOnly, "错误"

End Sub