vbnet 在autocad当中提取所有zhix图层和dmx图层相交点坐标以此点为分界点左右两侧分别提取dmx图层坐标点并输出到文本

以下是在AutoCAD中使用VB.NET编写的代码，用于提取所有zhix图层和dmx图层相交点坐标，并根据这些点将dmx图层坐标点分为左侧和右侧，并将结果输出到文本文件中：

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

Public Class ExtractCoordinates
    <CommandMethod("ExtractCoordinates")>
    Public Sub ExtractCoordinates()
        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 bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
            ' 打开模型空间块表记录
            Dim ms As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead)

            ' 创建图层名集合
            Dim layerNames As New List(Of String)()
            layerNames.Add("zhix")
            layerNames.Add("dmx")

            ' 获取所有相交点坐标
            Dim intersectPoints As New List(Of Point3d)()
            For Each layerName As String In layerNames
                ' 打开图层
                Dim layerId As ObjectId = GetLayerId(layerName, db)
                If layerId = ObjectId.Null Then
                    Continue For
                End If

                Dim layerTableRecord As LayerTableRecord = trans.GetObject(layerId, OpenMode.ForRead)
                ed.WriteMessage("正在处理图层: " + layerTableRecord.Name + vbCrLf)

                ' 提取坐标点
                Dim points As List(Of Point3d) = ExtractPoints(layerId, ms)
                intersectPoints.AddRange(points)
            Next

            ' 按X坐标排序
            intersectPoints.Sort(Function(p1, p2) p1.X.CompareTo(p2.X))

            ' 分割dmx图层坐标点
            Dim dmxPointsLeft As New List(Of Point3d)()
            Dim dmxPointsRight As New List(Of Point3d)()
            Dim isOnLeft As Boolean = True
            For Each point As Point3d In ExtractPoints(GetLayerId("dmx", db), ms)
                If isOnLeft AndAlso point.X >= intersectPoints(0).X Then
                    isOnLeft = False
                End If

                If isOnLeft Then
                    dmxPointsLeft.Add(point)
                Else
                    dmxPointsRight.Add(point)
                End If
            Next

            ' 输出到文本文件
            Dim filePath As String = "输出文件路径"
            Using sw As StreamWriter = New StreamWriter(filePath, False)
                sw.WriteLine("Left DMX Points:")
                For Each point As Point3d In dmxPointsLeft
                    sw.WriteLine(point.X.ToString() + " " + point.Y.ToString() + " " + point.Z.ToString())
                Next

                sw.WriteLine("Right DMX Points:")
                For Each point As Point3d In dmxPointsRight
                    sw.WriteLine(point.X.ToString() + " " + point.Y.ToString() + " " + point.Z.ToString())
                Next
            End Using

            trans.Commit()
        End Using

        ed.WriteMessage("坐标点提取完成！")
    End Sub

    Private Function GetLayerId(ByVal layerName As String, ByVal db As Database) As ObjectId
        Dim lt As LayerTable = TryCast(db.LayerTableId.GetObject(OpenMode.ForRead), LayerTable)
        If lt.Has(layerName) Then
            Return lt(layerName)
        End If

        Return ObjectId.Null
    End Function

    Private Function ExtractPoints(ByVal layerId As ObjectId, ByVal ms As BlockTableRecord) As List(Of Point3d)
        Dim points As New List(Of Point3d)()

        For Each objId As ObjectId In ms
            Dim ent As Entity = TryCast(objId.GetObject(OpenMode.ForRead), Entity)
            If ent IsNot Nothing AndAlso ent.LayerId = layerId Then
                Dim intPoints As New Point3dCollection()
                ent.IntersectWith(ms, Intersect.OnBothOperands, intPoints, IntPtr.Zero, IntPtr.Zero)

                For Each intPoint As Point3d In intPoints
                    points.Add(intPoint)
                Next
            End If
        Next

        Return points
    End Function
End Class

请将代码中的"输出文件路径"替换为您希望输出的文本文件路径。您可以将代码保存到一个VB.NET类文件中，并在AutoCAD中加载该文件后，在命令行中输入"ExtractCoordinates"来运行该命令。成功运行后，输出文件将包含左侧和右侧dmx图层的坐标点