孔表

Imports ZwSoft.ZwCAD.Runtime
Imports ZwSoft.ZwCAD.EditorInput
Imports ZwSoft.ZwCAD.ApplicationServices
Imports ZwSoft.ZwCAD.DatabaseServices
Imports ZwSoft.ZwCAD.Geometry


Public Class FilterTest
    <CommandMethod("HOLECHART")> _
    Public Sub FilterTest()
        '' Get the current document editor
        Dim acDocEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor


        '获取用户输入的插入点
        Dim pto As PromptPointOptions = New PromptPointOptions(vbLf + "Please select the Hole Chart Location: ")
        Dim ptres As PromptPointResult = acDocEd.GetPoint(pto)
        Dim ipt As Point3d
        If ptres.Status <> PromptStatus.Cancel Then
            ipt = ptres.Value
        Else
            Return
        End If


        '获取用户输入的高度
        Dim THeight As PromptDoubleOptions = New PromptDoubleOptions(vbLf + "Enter the height of the text in 1:1 Scale: ")
        Dim THeightRes As PromptDoubleResult = acDocEd.GetDouble(THeight)
        Dim Text_Height As Double
        If THeightRes.Status <> PromptStatus.Cancel Then
            Text_Height = THeightRes.Value
        Else
            Return
        End If




        '' Create a TypedValue array to define the filter criteria
        Dim acTypValAr(0) As TypedValue
        acTypValAr.SetValue(New TypedValue(DxfCode.Start, "CIRCLE"), 0)
        '' Assign the filter criteria to a SelectionFilter object
        Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
        '' Request for objects to be selected in the drawing area
        Dim acSSPrompt As PromptSelectionResult
        acSSPrompt = acDocEd.GetSelection(acSelFtr)
        '' If the prompt status is OK, objects were selected
        If acSSPrompt.Status = PromptStatus.OK Then
            Dim acSSet As SelectionSet = acSSPrompt.Value
            Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
            Using acTrans As Transaction = db.TransactionManager.StartTransaction()
                Dim acBlkTbl As BlockTable = acTrans.GetObject(db.BlockTableId, OpenMode.ForRead)
                Dim acBlkTblRec As BlockTableRecord = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)


                Dim i As Integer = 1
                Dim j As Integer = 0
                Dim midpoint As Point3d
                Dim maxpoint As Point3d
                For Each obj As SelectedObject In acSSet
                    Dim s As String = obj.ObjectId.ToString
                    s = s.Trim(New Char() {"("c, ")"c})
                    Dim C_center As String = "%<\AcObjProp Object(" + "%<\_ObjId " + s + ">%).Center \f ""%lu2"">%"
                    Dim C_radius As String = "%<\AcObjProp Object(" + "%<\_ObjId " + s + ">%).Radius \f ""%lu2"">%"


                    Dim ent As Circle = acTrans.GetObject(obj.ObjectId, OpenMode.ForRead)


                    Dim C_text As MText = New MText()
                    C_text.Location = ent.Center
                    C_text.TextHeight = Text_Height
                    acBlkTblRec.AppendEntity(C_text)
                    acTrans.AddNewlyCreatedDBObject(C_text, True)
                    C_text.ZcadObject.TextString = "H" & i.ToString


                    Dim item_num As MText = New MText()
                    item_num.Location = New Point3d(ipt.X, ipt.Y - j * (Text_Height + 5), 0)
                    item_num.TextHeight = Text_Height
                    acBlkTblRec.AppendEntity(item_num)
                    acTrans.AddNewlyCreatedDBObject(item_num, True)
                    item_num.ZcadObject.TextString = "H" & i.ToString


                    midpoint = item_num.GeometricExtents.MinPoint
                    maxpoint = item_num.GeometricExtents.MaxPoint
                    Dim num_W As Double = maxpoint.X - midpoint.X + 10




                    Dim item_radius As MText = New MText()
                    item_radius.Location = New Point3d(ipt.X + num_W, ipt.Y - j * (Text_Height + 5), 0)
                    item_radius.TextHeight = Text_Height
                    acBlkTblRec.AppendEntity(item_radius)
                    acTrans.AddNewlyCreatedDBObject(item_radius, True)
                    item_radius.ZcadObject.TextString = C_radius 'This step must be done AFTER the new text is append to database


                    midpoint = item_radius.GeometricExtents.MinPoint
                    maxpoint = item_radius.GeometricExtents.MaxPoint
                    Dim radius_W As Double = maxpoint.X - midpoint.X + 10


                    Dim item_center As MText = New MText()
                    item_center.Location = New Point3d(ipt.X + num_W + radius_W, ipt.Y - j * (Text_Height + 5), 0)
                    item_center.TextHeight = Text_Height
                    acBlkTblRec.AppendEntity(item_center)
                    acTrans.AddNewlyCreatedDBObject(item_center, True)
                    item_center.ZcadObject.TextString = C_center 'This step must be done AFTER the new text is append to database


                    i = i + 1
                    j = j + 1
                Next
                acTrans.Commit()
            End Using
        Else
            Application.ShowAlertDialog("Number of objects selected: 0")
        End If
    End Sub
End Class