AutoCAD VB.NET: 提取 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' 图层的坐标点。