AutoCAD二次开发基础（四）：多义线

AutoCAD二次开发系列

---

前言

为了便于数据交换，需把样条曲线转换为多义线。

---

一、样条曲线转化为多义线

思想：将样条曲线依据 X 坐标 N 等分，依次连接等分点得到多义线。

Function plToSpline(sp as AcadSpline) as AcadLWPolyline  ' 与函数名同名的变量即为返回值
segNum = 100  ' 多义线段数
ReDim pta(0 To (segNum + 1) * 2 - 1) as double  ' 多义线只有x、y坐标
X0 = sp.ControlPoints(0)  ' 第一个控制点 x 坐标
X1 = sp.ControlPoints(3 * sp.NumberOfControlPoints - 3)  ' 最后一个控制点 x 坐标
Dim x as Double
For i = 0 To segNum
	x = X0 + i * (X1 - X0) / segNum
	y = findY(sp, x)  ' findY是一个自定义函数，输入为一条曲线和一个横向位置，输出曲线在该位置的值。
	pta(i * 2) = x : pta(i * 2 + 1) = y
Next i
Set plToSpline = ThisDrawing.ModelSpace.AddLightWeightPolyline(pta)  ' AcadPolyline已被废除，不使用;LightWeightPolyline简写为AcadLWPolyline
End Function

findY函数定义为：

Function findY(cur As AcadEntity, x As Double) As Double
Dim pt0(2) As Double
Dim pt1(2) As Double
pt0(0) = x
pt1(0) = x: pt1(1) = 1
Set x1 = ThisDrawing.ModelSpace.AddXline(pt0, pt1)
ipa = cur.IntersectWith(x1, acExtendBoth)
If UBound(ipa) >= 2 Then
    findY = ipa(1)
Else
findY = 1000000#
End If
x1.Delete
End Function

二、梯形法计算多义线面积及形心坐标

梯形法为数值积分一种常用方法。定义函数，运用梯形法，给定多义线，返回多义线的面积。

Function areaUnderPolyline(pl as AcadLWPolyline, pxc as double) as double
sumA = 0 : sumM = 0
num = (UBound(pl.Coordinates) + 1) \ 2  ' 多义线段数
For i = 1 To num - 1
	x1 = pl.Coordinates((i - 1) * 2) : y1 = pl.Coordinates((i - 1) * 2 + 1)
	x2 = pl.Coordinates(i * 2) : y2 = pl.Coordinates(i * 2 + 1)
	darea = (y1 + y2) * (x2 - x1) / 2
	xc = (y1 + 2 * y2) / 3 / (y1 + y2) * (x2 - x1) + x0  ' 梯形形心
	dm = da * xc
	sumA = sumA + darea
	sumM = sumM + dm
Next i
areaUnderPolyline = sumA
pxc = sumM/sumA
End Function

在主函数中调用：

Sub main()
getShipLine
Dim xc as double
for I = 0 to ex_lineNum - 1
	a = areaUnderPolyline(ex_shipLine(I), xc)
	ThisDrawing.Utility.Prompt Format(a, ".00") & vbCrLf  ' vbcrlf为换行符
Next I
End Sub

其中，getShipLine为选择型线的自定义函数：

Dim ex_lineNum as integer  '全局变量，选择型线的数量
Dim ex_shipLine(1000) as AcadEntity  ' 全局变量，选择型线的集合
Sub getShipLine()
Dim ss1 as AcadSelectionSet
Set ss1 = ThisDrawing.SelectionSets.Add("sett1")
ss1.SelectOnScreen
ex_lineNum = 0
For each ent in ss1
	set ex_shipLine(ex_lineNum) = ent
	ex_lineNum = ex_lineNum + 1
Next
ss1.delete
End Sub

运行结果：

---