遇到要求单行文字包围和的需求,发现AutoCAD自带的算法仅能求出正交包围盒,如下图所示的粉色矩形
我想获取下图下图所示蓝色矩形的部分及OBB
计算方法图形示例:
下面是完整的代码,其中求D点的坐标p1涉及到向量定比分点公式
<CommandMethod(NameOf(TT_SingleTextOBB))>
Sub TT_SingleTextOBB()
Dim acDoc = Application.DocumentManager.MdiActiveDocument
Dim acDb = Application.DocumentManager.MdiActiveDocument.Database
Dim acEd = Application.DocumentManager.MdiActiveDocument.Editor
If Application.GetSystemVariable("WIPEOUTFRAME") <> "0" Then
Application.SetSystemVariable("WIPEOUTFRAME", 0)
End If
Dim pso As New Autodesk.AutoCAD.EditorInput.PromptSelectionOptions With
{
.RejectObjectsOnLockedLayers = True,
.MessageForAdding = "选择单行文字", .SelectEverythingInAperture = False
}
Dim pv As New TypedValue(DxfCode.Start, "Text")
Dim psr = acEd.GetSelection(pso, New SelectionFilter({pv}))
Try
If psr.Status = PromptStatus.OK Then
Using tr As Transaction = acDb.TransactionManager.StartTransaction()
Dim bt As BlockTable = tr.GetObject(acDb.BlockTableId, OpenMode.ForRead)
Dim ms As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'Dim groupDicts As DBDictionary = tr.GetObject(acDb.GroupDictionaryId, OpenMode.ForRead)
For Each item As SelectedObject In psr.Value
Try
'获取文字正交的包围盒
Dim t As DBText = tr.GetObject(item.ObjectId, OpenMode.ForRead)
Dim bingbox = t.GeometricExtents
Dim width = bingbox.MaxPoint.X - bingbox.MinPoint.X
Dim height = bingbox.MaxPoint.Y - bingbox.MinPoint.Y
Dim pa As New Point2d(0.5 * (bingbox.MaxPoint.X + bingbox.MinPoint.X), 0.5 * (bingbox.MaxPoint.Y + bingbox.MinPoint.Y)) '正交包围的形心
Dim pb = New Point2d(bingbox.MinPoint.X, bingbox.MinPoint.Y) '正交包围的左下角
Dim α = t.Rotation, tol = 0.000001
Dim pc = pb.Add(New Vector2d(width, 0)) '正交包围的右下角
Dim vpab = pa.GetVectorTo(pb) '向量AB
Dim vpac = pa.GetVectorTo(pc) '向量AC
Dim vpad As New Vector2d(vpab.X, vpab.Y) '向量AD
Dim x = width, y = height 'OBB包围盒的宽度和高度
If Math.Abs(Math.Sin(α)) > tol And Math.Abs(Math.Cos(α)) > tol Then '排除正交包围盒本身就是OBB包围盒的情况
'Dim k1 = (Math.Cos(α) - Math.Sin(α)) / (Math.Tan(α) - 1.0 / Math.Tan(α))
x = (width / Math.Sin(α) - height / Math.Cos(α)) / (1.0 / Math.Tan(α) - Math.Tan(α))
y = (width / Math.Cos(α) - height / Math.Sin(α)) / (Math.Tan(α) - 1.0 / Math.Tan(α))
'acEd.WriteMessage($"{x},{y}" + Environment.NewLine)
'向量定比分点公式求出向量AD
vpad = (vpab * x * Math.Cos(α) + vpac * y * Math.Sin(α)) / width
End If
Dim p1 = pa.Add(vpad)
Dim ang1 = 2 * Math.Atan(x / y) '求出第OBB包围盒左下角点到右下角点的旋转角
Dim p2 = p1.RotateBy(ang1, pa)
Dim p3 = p1.RotateBy(Math.PI, pa)
Dim p4 = p2.RotateBy(Math.PI, pa)
Dim obbPoly As New Polyline
obbPoly.AddVertexAt(0, p1, 0, 0, 0)
obbPoly.AddVertexAt(1, p2, 0, 0, 0)
obbPoly.AddVertexAt(2, p3, 0, 0, 0)
obbPoly.AddVertexAt(3, p4, 0, 0, 0)
obbPoly.AddVertexAt(4, p1, 0, 0, 0)
Dim oid = ms.AppendEntity(obbPoly)
tr.AddNewlyCreatedDBObject(obbPoly, True)
Catch ex As System.Exception
Application.ShowAlertDialog(ex.StackTrace)
Continue For
End Try
Next
tr.Commit()
End Using
End If
Catch ex As System.Exception
Application.ShowAlertDialog(ex.StackTrace)
End Try
End Sub
代码测试截图
