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