AutoCAD二次开发基础（二）：曲线操作

AutoCAD二次开发系列

---

前言

样条曲线在船体型线设计中是使用较多的一类曲线，通过曲线求交等操作，可通过插值水线快速绘制横剖线和纵剖线。

---

一、AutoCAD中曲线分类

含义	类型名称	含义	类型名称
直线	AcadLine	射线	AcadXLine
圆	AcadCircle	圆弧	AcadArc
多义线	AcadPolyline	样条曲线	AcadSpline

二、曲线的通用操作

含义	名称	含义	名称
求交	IntersectWith	镜像	Mirror
移动	Move	三维镜像	Mirror3D
偏移	Offset	旋转	Rotate
缩放	ScaleEntity	三维旋转	Rotate3D

1.编辑样条曲线型值点

提取并绘制样条曲线的型值点：

Sub getFitPoint()
Dim pt(2) as double
Dim s0 as AcadSpline
ThisDrawing.Utility.GetEntity so, p1, "选择曲线"
For i = 0 to so.NumberOfFitPoints - 1  ' NumberOfFitPoints: 样条曲线型值点个数
	pt(0) = so.fitPoints(i*3)
	pt(1) = so.fitPoints(i*3 + 1)
	pt(2) = so.fitPoints(i*3 + 2)
	Set point = ThisDrawing.ModelSpace.AddPoint(pt)
	point.Color = 2
Next i
End Sub

鼠标拾取点，将其插入选中的样条曲线：

Sub addPtToSpline()
Dim sp as acadSpline
Dim pt as Variant
On error goto toExit:
ThisDrawing.Utility.GetEntity sp, pp, "选择一条样条曲线"  ' pp为点击进行选择时光标所在点的位置,为该方法返回值之一
While(True)
	pt = ThisDrawing.Utility.GetPoint(pp, "选择要插入的点")  ' 选择样条曲线时返回的pp作为选择点时的参考点
	pp(0) = pt(0) : pp(1) = pt(1)  ' 将插入点作为下一次选择点时的参考点
	For i = 0 to sp.NumberofFitPoints - 1
		x_0 = sp.FitPoints(3 * i)
		x_1 = sp.FitPoints(3 * (i + 1))
		If (pt(0) - x_0) * (pt(0) - x_1) < 0 Then  ' 插入与其横向距离最近的两个点之间
			sp.AddFitPoint i+1, pt
			Exit For
		End If
	Next i
Wend
toExit:
End Sub

删除选中曲线的一个指定型值点：

Sub deletePtFromSpline()
Dim sp as AcadSpline
Dim pt as Variant
On Error GoTo toExit:
ThisDrawing.Utility.GetEntity sp, pp, "选择一条样条曲线"
pt = ThisDrawing.Utility.GetPoint(pp, "选择一个点")
mindis = 1000000
minIndex = 0
For i = 0 To sp.NumberOfFitPoints - 1
	x_0 = sp.FitPoints(3 * i)
	y_0 = sp.FitPoints(3 * i + 1)
	dis = Sqr((pt(0) - x_0)^2 + (pt(1) - y_0)^2)
	If dis < mindis Then  ' 找出与所选择点距离最近的型值点，然后删除
		mindis = dis
		minIndex = i
	End If
Next i
sp.DeleteFitPoint minIndex
toExit:
If Err.Number Then MsgBox Err.Description
End Sub

2.曲线求交点

曲线求交点主要运用到如下函数：

pta = curve.IntersectWith(curve1, type)
pta: 交点数组(double)
pta的点数: (UBound(pta) + 1) / 3
curve1: 待求交的曲线
Type：是否延长两曲线

type取值有：

名称	含义
acExtendNone	不延长任何一条曲线
acExtendThisEntity	延长curve
acExtendOtherEntity	延长curve1
acExtendBoth	延长所有曲线

求取并绘制两条曲线的所有交点：

Sub curveIntersections()
Dim c1 as AcadEntity
Dim c2 as AcadEntity
Dim pt(2) as Double
On Error GoTo endSub
ThisDrawing.Utility.GetEntity c1, pt, "选择第一条曲线"
ThisDrawing.Utility.GetEntity c2, pt, "选择第二条曲线"
pta = c1.IntersectWith(c2, acExtendNone)
Count = (UBound(pta) + 1) / 3
For i = 0 to Count - 1
	pt(0) = pta(i * 3) : pt(1) = pta(i * 3 + 1)
	ThisDrawing.ModelSpace.AddPoint pt 
Next i
endSub:
End Sub

---