坐标标注编组

pmq

只是最后一组坐标编成组,其它的没变.


Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click '坐标标注
    Dim docLock As DocumentLock = Core.Application.DocumentManager.MdiActiveDocument.LockDocument() '“非模态窗口，要锁定文档”

    NativeMethods.SetFocus(Core.Application.DocumentManager.MdiActiveDocument.Window.Handle) 'CAD获得焦点

    Dim entYId As ObjectId
    Dim entXId As ObjectId
   
    Dim psr As PromptSelectionResult '请求在图形区域选择对象

    psr = ed.GetSelection() '屏幕选取

    Dim SetA As SelectionSet

    If psr.Status = PromptStatus.OK Then '如果提示状态OK，表示对象已选
        SetA = psr.Value
        For Each obj In SetA
            Using cTrans As Transaction = db.TransactionManager.StartTransaction() '开启事务处理

                Dim entity As Entity = CType(cTrans.GetObject(obj.ObjectId, OpenMode.ForWrite, True), Entity)

                Select Case entity.GetType.Name
                    Case "DBPoint"
                        Dim Poline As DBPoint = CType(cTrans.GetObject(obj.ObjectId, OpenMode.ForRead, True), DBPoint) '获取点实体对象
                        ' MsgBox(666)
                        Dim XYZ As Point3d = Poline.Position

                        Dim entX As New DBText With {
                            .TextString = XYZ.Y,     'X 文本
                            .Position = XYZ,   '三维点
                            .ColorIndex = 3,
                            .Rotation = 0,     '文字旋转角度
                            .Height = 0.3      '文字高度
                        }
                        entXId = AppendEntity(entX) '显示X

                        Dim entY = New DBText With {
                            .TextString = XYZ.X,'Y 文本
                            .Position = XYZ,    '三维点
                            .ColorIndex = 6,
                            .Rotation = 0,      '文字旋转角度
                            .Height = 0.3，     '文字高度
                            .VerticalMode = TextVerticalMode.TextTop,  '对齐
                            .AlignmentPoint = XYZ   '设置对齐点
                        }
                        entYId = AppendEntity(entY) '显示X


                        '========组===================================================================

                        Dim groupName As String = "MyGroup"

                        Using Trans As Transaction = db.TransactionManager.StartTransaction

                            Dim gp As New Group(groupName, True)

                            Dim dict As DBDictionary = Trans.GetObject(db.GroupDictionaryId, OpenMode.ForWrite)

                            dict.SetAt(groupName, gp)

                            Dim ids As New ObjectIdCollection From {
                                entXId,
                                entYId
                            }
                            gp.Append(ids)

                            Trans.AddNewlyCreatedDBObject(gp, True)
                            Trans.Commit()
                        End Using
                        '===========================================================================
                    Case Else

                End Select
                cTrans.Commit()
            End Using
        Next
    End If

    docLock.Dispose()
End Sub