以下是在 AutoCAD 中使用 VB.NET 提取 'zhix' 图层和 'dmx' 图层相交点下方第一个文字内容,并将其输出到文本文件的示例代码:

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports System.IO

Public Class ExtractTextBelowIntersect
    <CommandMethod("ExtractText")>
    Public Sub ExtractText()
        ' 获取当前文档和数据库
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database

        ' 开始事务处理
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            ' 获取当前文档的编辑器
            Dim ed As Editor = doc.Editor

            ' 提示用户选择 'zhix' 和 'dmx' 图层
            Dim zhixLayerName As String = ed.GetLayer("请选择 'zhix' 图层:")
            Dim dmxLayerName As String = ed.GetLayer("请选择 'dmx' 图层:")

            ' 获取 'zhix' 和 'dmx' 图层的 ObjectId
            Dim zhixLayerId As ObjectId = GetLayerId(db, zhixLayerName)
            Dim dmxLayerId As ObjectId = GetLayerId(db, dmxLayerName)

            ' 如果未找到图层,则退出
            If zhixLayerId = ObjectId.Null Or dmxLayerId = ObjectId.Null Then
                ed.WriteMessage("未找到指定图层!")
                Return
            End If

            ' 获取 'zhix' 和 'dmx' 图层的实体集合
            Dim zhixEntities As IEnumerable(Of ObjectId) = GetEntitiesOnLayer(db, zhixLayerId)
            Dim dmxEntities As IEnumerable(Of ObjectId) = GetEntitiesOnLayer(db, dmxLayerId)

            ' 创建一个用于存储结果的列表
            Dim results As New List(Of String)

            ' 遍历 'zhix' 图层的实体
            For Each zhixId As ObjectId In zhixEntities
                Dim zhixEntity As Entity = trans.GetObject(zhixId, OpenMode.ForRead)

                ' 获取 'zhix' 图层实体的边界框
                Dim zhixExtents As Extents3d = zhixEntity.Bounds

                ' 遍历 'dmx' 图层的实体
                For Each dmxId As ObjectId In dmxEntities
                    Dim dmxEntity As Entity = trans.GetObject(dmxId, OpenMode.ForRead)

                    ' 检查 'dmx' 图层实体是否与 'zhix' 图层实体相交
                    If zhixExtents.Intersects(dmxEntity.Bounds) Then
                        ' 获取相交点下方第一个文字内容
                        Dim text As String = GetTextBelowEntity(db, dmxId)

                        ' 如果找到文字内容,则添加到结果列表中
                        If Not String.IsNullOrEmpty(text) Then
                            results.Add(text)
                        End If
                    End If
                Next
            Next

            ' 将结果写入文本文件
            Dim outputPath As String = "C:\output.txt"
            File.WriteAllLines(outputPath, results)

            ed.WriteMessage("已将结果写入文本文件:" & outputPath)
            trans.Commit()
        End Using
    End Sub

    Private Function GetLayerId(db As Database, layerName As String) As ObjectId
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim layerTable As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForRead)
            If layerTable.Has(layerName) Then
                Return layerTable(layerName)
            End If
        End Using

        Return ObjectId.Null
    End Function

    Private Function GetEntitiesOnLayer(db As Database, layerId As ObjectId) As IEnumerable(Of ObjectId)
        Dim entities As New List(Of ObjectId)

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim layer As LayerTableRecord = trans.GetObject(layerId, OpenMode.ForRead)
            Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)

            For Each btrId As ObjectId In bt
                Dim btr As BlockTableRecord = trans.GetObject(btrId, OpenMode.ForRead)

                For Each entId As ObjectId In btr
                    Dim ent As Entity = trans.GetObject(entId, OpenMode.ForRead)

                    If ent.LayerId = layerId Then
                        entities.Add(entId)
                    End If
                Next
            Next
        End Using

        Return entities
    End Function

    Private Function GetTextBelowEntity(db As Database, entityId As ObjectId) As String
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim entity As Entity = trans.GetObject(entityId, OpenMode.ForRead)

            ' 检查实体是否为文字
            If TypeOf entity Is DBText Then
                Dim text As DBText = DirectCast(entity, DBText)
                Return text.TextString
            End If

            ' 检查实体是否为多行文字
            If TypeOf entity Is MText Then
                Dim mtext As MText = DirectCast(entity, MText)
                Return mtext.Contents
            End If
        End Using

        Return String.Empty
    End Function
End Class

请注意,以上代码假设您已经正确添加了对 Autodesk.AutoCAD.InteropAutodesk.AutoCAD.DatabaseServices 的引用,并且已将其添加到您的项目中。

AutoCAD VB.NET: 提取zhix 和 dmx 图层相交点下方第一个文字内容

原文地址: https://www.cveoy.top/t/topic/qEN5 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录