VBNET AUTOCAD 单行文字OBB有向包围盒的计算

vbnet,autocad,单行,文字,obb,包围,计算 · 浏览次数 : 37

小编点评

**代码测试截图** 代码测试截图中包含以下图像: **粉色矩形**:正交包围盒 **蓝色矩形**:OBB包围盒 **代码描述:** 该代码包含一个名为 `TT_SingleTextOBB` 的函数,该函数使用 AutoCAD 的 API 获取下图中蓝色矩形的 OBB(外接边界框)的坐标。 **代码步骤:** 1. 获取文档管理器中的活动文档。 2. 获取文档中的数据库。 3. 获取文档中的编辑器。 4. 设置选择对象选项,包括拒绝锁定层和选择所有在视窗内的对象。 5. 从文档中获取选择的对象。 6. 从文档中获取文字的几何边界框。 7. 计算正交包围盒的最小外接点和最大外接点。 8. 计算向量 AD、BC 和 CD。 9. 根据向量 AD、BC 和 CD 计算 OBB 的宽度和高度。 10. 创建一个新的ruly 线段,并添加其顶点。 11. 将ruly 线段添加到文档中。 **注意:** * 代码中的 `Math.Abs()` 函数用于确保正交包围盒的边框宽度和高度大于或等于 0.000001。这确保了正确性。 * 代码中使用 `Atan()` 函数计算角度。 * 代码中使用 `AppendVertexAt()` 方法创建 OBB 的顶点。

正文

遇到要求单行文字包围和的需求,发现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
        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)
                    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

 

代码测试截图

与VBNET AUTOCAD 单行文字OBB有向包围盒的计算相似的内容:

VBNET AUTOCAD 单行文字OBB有向包围盒的计算

遇到要求单行文字包围和的需求,发现AutoCAD自带的算法仅能求出正交包围盒,如下图所示的粉色矩形 我想获取下图下图所示蓝色矩形的部分及OBB 计算方法图形示例: 下面是完整的代码,其中求D点的坐标p1涉及到向量定比分点公式

AutoCAD VBNET 当前文档保存

当前文档保存总出问题 现在借助com的方法实现了保存文件 Public Sub TT_SaveDrawing() Dim doc As Document = Application.DocumentManager.Mdi

AutoCAD VBNET 获取曲线在3个基本平面的投影

求取空间任意曲线在xoy/yoz/xoz平面的投影 Public Sub TT_CurveProjected() Dim doc As Document = Application.DocumentManager.

AutoCAD VBNET 曲线求交点

曲线求取点,利用几何库 Public Sub TT_PolyLineCrossCheck() Dim doc As Document = Application.DocumentManager.MdiAct

Aveva Marine VBNET 编程系列-修改程序快捷键

修改HullDesign程序的主题以及菜单项的快捷键 引用的dll文件 下面的是代码和快捷键配置文件: https://files.cnblogs.com/files/NanShengBlogs/AMShortCut.HullDesign.zip?t=1695908179&download=true

Aveva Marine VBNET 编程系列-新建图纸,创建文字

根据MarApi,创建图形文件,新建文字 Imports Aveva.ApplicationFramework.Presentation Imports Aveva.Marine.Drafting ' marAPI.dll Public Class 绘图控制

Aveva Marine VBNET 编程系列-创建曲线

显现的效果 代码实现: Public Sub 新建曲线(wm As WindowManager) Dim draftApp As New MarDrafting Dim ui As New MarUi 'Im

Aveva Marine VBNET 编程系列-封装一个类

由于AM的marapi的大部分类实现了IDisposable接口,所有避免内存过大,用了一般需要dispose下 微软官方的解释: https://learn.microsoft.com/zh-cn/dotnet/api/system.idisposable?view=net-7.0 以下是MarD

Aveva Marine VBNET 编程系列===>读取drawing explorer的第一层级 view

今天我们研究下读取drawing expolrer的第一层级:view 下面的图纸的层级目录示意图,我们今天需要获取所有的view 主要用到2个方法: 1# 获取第一个元素 MarDrafting.ElementChildFirstGet Method () 2# 获取相邻的元素 MarDrafti

Aveva Marine VBNET 编程系列====>读取drawing explorer的第2层级 Sub views

接上期的内容,此次读取view的下一层几subview 主要用到下面的方法获取view的第一个子级 一个封装的类 Public Class DrawingExpolrerEx Public Shared Function DrawingHasViews(draftApp As MarDrafting