vbnet 在autocad当中提取所有zhix和dmx图层相交点坐标正下方的第一个文字内容并输出到文本
以下是一个实现提取所有zhix和dmx图层相交点坐标正下方的第一个文字内容,并输出到文本的示例代码:
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Public Class Program
<STAThread>
Public Shared Sub Main()
' 获取AutoCAD的文档对象
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
' 获取文档数据库
Dim db As Database = doc.Database
' 获取编辑器对象
Dim ed As Editor = doc.Editor
Using trans As Transaction = db.TransactionManager.StartTransaction()
' 获取当前空间
Dim space As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForRead)
' 获取所有图层名
Dim layerNames As List(Of String) = New List(Of String)() From {"zhix", "dmx"}
' 创建一个文本文件用于保存结果
Dim outputFilePath As String = "C:\output.txt"
Dim outputFile As System.IO.StreamWriter = New System.IO.StreamWriter(outputFilePath)
' 遍历每个图层
For Each layerName As String In layerNames
' 获取图层Id
Dim layerId As ObjectId = GetLayerId(layerName, db)
' 获取图层对象
Dim layer As LayerTableRecord = trans.GetObject(layerId, OpenMode.ForRead)
' 获取相交点集合
Dim intersectionPoints As List(Of Point3d) = GetIntersectionPoints(trans, space, layerId)
' 遍历每个相交点
For Each intersectionPoint As Point3d In intersectionPoints
' 获取正下方第一个文字内容
Dim textContent As String = GetTextBelowPoint(trans, space, intersectionPoint)
' 输出结果到文本文件
outputFile.WriteLine($"图层:{layer.Name},坐标:{intersectionPoint.ToString()},文字内容:{textContent}")
Next
Next
' 关闭文件
outputFile.Close()
' 提示输出文件路径
ed.WriteMessage($"结果已保存到文件:{outputFilePath}")
End Using
End Sub
' 根据图层名称获取图层Id
Private Shared Function GetLayerId(layerName As String, db As Database) As ObjectId
Dim layerId As ObjectId = ObjectId.Null
Using lt As LayerTable = CType(db.LayerTableId.GetObject(OpenMode.ForRead), LayerTable)
If lt.Has(layerName) Then
layerId = lt(layerName)
End If
End Using
Return layerId
End Function
' 获取相交点集合
Private Shared Function GetIntersectionPoints(trans As Transaction, space As BlockTableRecord, layerId As ObjectId) As List(Of Point3d)
Dim intersectionPoints As List(Of Point3d) = New List(Of Point3d)()
Using entOptions As PromptEntityOptions = New PromptEntityOptions("选择一条线:")
entOptions.SetRejectMessage("请选择有效的直线。")
entOptions.AddAllowedClass(GetType(Line), False)
Dim entResult As PromptEntityResult = trans.GetObject(Application.DocumentManager.MdiActiveDocument.Editor.GetEntity(entOptions).ObjectId, OpenMode.ForRead)
Dim line As Line = CType(entResult.ObjectId.GetObject(OpenMode.ForRead), Line)
Dim filter As TypedValue() = New TypedValue() {New TypedValue(DxfCode.LayerName, layerId)}
Using entIter As BlockTableRecordEnumerator = space.GetEnumerator()
entIter.SetFilter(filter)
Do While entIter.MoveNext()
Dim entity As Entity = CType(entIter.Current.GetObject(OpenMode.ForRead), Entity)
Dim intersections As Point3dCollection = New Point3dCollection()
line.IntersectWith(entity, Intersect.OnBothOperands, intersections, IntPtr.Zero, IntPtr.Zero)
For Each intersection As Point3d In intersections
intersectionPoints.Add(intersection)
Next
Loop
End Using
End Using
Return intersectionPoints
End Function
' 获取正下方第一个文字内容
Private Shared Function GetTextBelowPoint(trans As Transaction, space As BlockTableRecord, point As Point3d) As String
Dim textContent As String = ""
Dim filter As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "TEXT")}
Using entIter As BlockTableRecordEnumerator = space.GetEnumerator()
entIter.SetFilter(filter)
Do While entIter.MoveNext()
Dim entity As Entity = CType(entIter.Current.GetObject(OpenMode.ForRead), Entity)
Dim text As DBText = TryCast(entity, DBText)
' 判断文字是否在点的正下方
If text IsNot Nothing AndAlso Math.Abs(text.Position.X - point.X) < 0.01 AndAlso text.Position.Y < point.Y Then
textContent = text.TextString
Exit Do
End If
Loop
End Using
Return textContent
End Function
End Class
此代码假设在AutoCAD中已经存在了名为"zhix"和"dmx"的两个图层,其中"zhix"和"dmx"图层的属性已经正确设置。代码将遍历这两个图层,找到每个图层与"zhix"和"dmx"图层相交的点,并获取正下方的第一个文字内容。然后将结果输出到指定的文本文件中。请确保代码中的输出文件路径是正确的,并且有足够的权限来写入该文件
原文地址: http://www.cveoy.top/t/topic/i0ne 著作权归作者所有。请勿转载和采集!