园盘菜单 VB.net 源码_CAD中文技术交流网

园盘菜单 VB.net 源码

本帖最后由 pmq 于 2025-11-2 20:39 编辑

[hide]Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Threading
Imports System.Drawing.Drawing2D
Imports Font = System.Drawing.Font
Public Class RadialMenuDemo
Implements IExtensionApplication
Private Shared pendingAction As Action = Nothing
Private Shared targetCadPoint As Point3d = Point3d.Origin
Private Shared radialForm As RadialSectorMenuForm = Nothing
Public Sub Initialize() Implements IExtensionApplication.Initialize
End Sub
Public Sub Terminate() Implements IExtensionApplication.Terminate
If radialForm IsNot Nothing AndAlso Not radialForm.IsDisposed Then
If radialForm.InvokeRequired Then
radialForm.Invoke(New Action(Sub() radialForm.Close()))
Else
radialForm.Close()
End If
radialForm = Nothing
End If
End Sub
<CommandMethod("RadialMenu")>
Public Sub ShowRadialMenuCommand()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
If radialForm IsNot Nothing AndAlso Not radialForm.IsDisposed Then
If radialForm.InvokeRequired Then
radialForm.Invoke(New Action(Sub() radialForm.Close()))
Else
radialForm.Close()
End If
radialForm = Nothing
End If
Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "点击弹出可拖动轮盘菜单：" & vbCrLf & " - 拖动内圆移动菜单" & vbCrLf & " - 点击功能扇区执行命令" & vbCrLf & " - 点击内圆/外圆外关闭菜单")
If ppr.Status <> PromptStatus.OK Then
ed.WriteMessage(vbLf & "命令已取消。")
Return
End If
targetCadPoint = ppr.Value
Dim screenPoint As System.Drawing.Point = Cursor.Position
Dim sectors As New List(Of RadialSector) From {
New RadialSector("展点", Color.FromArgb(255, 80, 160, 220), AddressOf DrawZD),
New RadialSector("绘制图框", Color.FromArgb(255, 60, 140, 200), AddressOf DrawTK),
New RadialSector("绘剖面线", Color.FromArgb(255, 40, 120, 180), AddressOf DrawPMX),
New RadialSector("剖面计算", Color.FromArgb(255, 160, 120, 220), AddressOf DrawPMJS),
New RadialSector("剖面绘制", Color.FromArgb(255, 140, 100, 200), AddressOf DrawPMHZ),
New RadialSector("坐标标注", Color.FromArgb(255, 80, 200, 140), AddressOf ZBBZ),
New RadialSector("自动编号", Color.FromArgb(255, 150, 180, 120), AddressOf AutoBH),
New RadialSector("高程点内插", Color.FromArgb(255, 240, 140, 80), AddressOf CalcElevationByPoints),
New RadialSector("文本求和", Color.FromArgb(255, 223, 127, 60), AddressOf TextSummation),
New RadialSector("范围线", Color.FromArgb(255, 80, 220, 200), AddressOf AutoAlphaBoundary),
New RadialSector("生成坐标", Color.FromArgb(255, 60, 200, 180), AddressOf ZDfile),
New RadialSector("范围缩放", Color.FromArgb(255, 240, 200, 80), AddressOf OpenAll),
New RadialSector("打开所有", Color.FromArgb(255, 230, 191, 127), AddressOf DQtc),
New RadialSector("显示当前", Color.FromArgb(255, 220, 180, 40), AddressOf ZooE),
New RadialSector("关闭菜单", Color.FromArgb(255, 160, 160, 160), AddressOf CloseMenu)
}
Dim thread As New Thread(Sub() ShowNonModalDraggableForm(sectors, screenPoint)) With {.IsBackground = True}
thread.SetApartmentState(ApartmentState.STA)
thread.Start()
End Sub
Private Sub CloseMenu()
Dim docLock As DocumentLock = Core.Application.DocumentManager.MdiActiveDocument.LockDocument
If radialForm IsNot Nothing AndAlso Not radialForm.IsDisposed Then
If radialForm.InvokeRequired Then
radialForm.Invoke(New Action(Sub() radialForm.Close()))
Else
radialForm.Close()
End If
End If
docLock.Dispose()
End Sub
Private Sub DrawZD()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus()
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_ZD ", True, False, False)
End Sub
Private Sub DrawTK()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus()
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_Rec ", True, False, False)
End Sub
Private Sub DrawPMX()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus()
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_point ", True, False, False)
End Sub
Private Sub DrawPMJS()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus()
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_point ", True, False, False)
End Sub
Private Sub DrawPMHZ()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus()
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_point ", True, False, False)
End Sub
'坐标标注
Private Sub ZBBZ()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus()
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_ZBBZ ", True, False, False)
End Sub
'自动编号
Private Sub AutoBH()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus()
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_AutoBH ", True, False, False)
End Sub
'高程点内插
Private Sub CalcElevationByPoints()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() ' CAD获得焦点
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_CalcElevationByPoints ", True, False, False)
End Sub
'范围线
Private Sub AutoAlphaBoundary()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() ' CAD获得焦点
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_AutoAlphaBoundary ", True, False, False)
End Sub
'文本求和求平均值
Private Sub TextSummation()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() ' CAD获得焦点
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_TextSummation ", True, False, False)
End Sub
'生成三维坐标文件
Private Sub ZDfile()
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
Dim ffName As New Zd_XyhFiles
ffName.Show()
End Sub
'打开所有
Private Sub OpenAll()
End Sub
'只显示当前层
Private Sub DQtc()
DQtc()
End Sub
' 范围缩放
Private Sub ZooE()
Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() ' CAD获得焦点
Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
acDoc.SendStringToExecute("_Zoom E ", True, False, False)
End Sub
'===============================================================================================
Private Sub ShowNonModalDraggableForm(sectors As List(Of RadialSector), screenPos As System.Drawing.Point)
Try
System.Windows.Forms.Application.SetCompatibleTextRenderingDefault(False)
radialForm = New RadialSectorMenuForm(sectors) With {
.StartPosition = FormStartPosition.Manual
}
radialForm.Location = New System.Drawing.Point(
screenPos.X - radialForm.Width \ 2,
screenPos.Y - radialForm.Height \ 2
)
' 绑定窗体事件（仅保留ActionTriggered，简化事件机制）
AddHandler radialForm.FormClosed, AddressOf RadialForm_Closed
AddHandler radialForm.ActionTriggered, AddressOf OnActionTriggered
radialForm.Show()
System.Windows.Forms.Application.Run()
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(
$"菜单加载错误：{ex.Message}", "错误提示",
System.Windows.Forms.MessageBoxButtons.OK, System.Windows.Forms.MessageBoxIcon.Error
)
End Try
End Sub
Private Sub RadialForm_Closed(sender As Object, e As FormClosedEventArgs)
radialForm = Nothing
System.Windows.Forms.Application.ExitThread()
End Sub
Private Sub OnActionTriggered(action As Action)
If action Is Nothing Then Return
pendingAction = action
AddHandler Autodesk.AutoCAD.ApplicationServices.Application.Idle, AddressOf ExecuteActionOnCADMainThread
End Sub
Private Sub ExecuteActionOnCADMainThread(sender As Object, e As EventArgs)
RemoveHandler Autodesk.AutoCAD.ApplicationServices.Application.Idle, AddressOf ExecuteActionOnCADMainThread
If pendingAction IsNot Nothing Then
pendingAction.Invoke()
pendingAction = Nothing
End If
End Sub
' ---------------------- ----------------------
Friend Class RadialSector
Public Property Text As String
Public Property FillColor As Color
Public Property Action As Action
Public Sub New(text As String, fillColor As Color, action As Action)
Me.Text = text
Me.FillColor = fillColor
Me.Action = action
End Sub
End Class
' ---------------------- ----------------------
Friend Class RadialSectorMenuForm
Inherits Form
Public Event ActionTriggered(action As Action)
Private isDragging As Boolean = False
Private dragStartMousePos As Point
Private dragStartFormPos As Point
Private ReadOnly sectors As List(Of RadialSector)
Private ReadOnly radiusOuter As Integer = 140
Private ReadOnly radiusInner As Integer = 40
Private ReadOnly menuFont As Font
Public Sub New(sectors As List(Of RadialSector))
Me.sectors = sectors
FormBorderStyle = FormBorderStyle.None
ShowInTaskbar = False
TopMost = True
BackColor = Color.Magenta
TransparencyKey = Color.Magenta
DoubleBuffered = True
Size = New Size(radiusOuter * 2, radiusOuter * 2)
menuFont = New Font("宋体", 10, FontStyle.Bold)
AddHandler MouseDown, AddressOf Form_MouseDown
AddHandler MouseMove, AddressOf Form_MouseMove
AddHandler MouseUp, AddressOf Form_MouseUp
AddHandler MouseClick, AddressOf Form_MouseClick
AddHandler Paint, AddressOf Form_Paint
End Sub
Private Sub Form_MouseDown(sender As Object, e As MouseEventArgs)
If e.Button <> MouseButtons.Left Then Return
Dim formCenter As New System.Drawing.Point(Width \ 2, Height \ 2)
Dim mouseOffsetX As Integer = e.X - formCenter.X
Dim mouseOffsetY As Integer = e.Y - formCenter.Y
Dim distanceToCenter As Double = Math.Sqrt(mouseOffsetX ^ 2 + mouseOffsetY ^ 2)
If distanceToCenter <= radiusInner Then
isDragging = True
dragStartMousePos = Cursor.Position
dragStartFormPos = Me.Location
Cursor = Cursors.Hand
End If
End Sub
Private Sub Form_MouseMove(sender As Object, e As MouseEventArgs)
If Not isDragging Then Return
Dim offsetX As Integer = Cursor.Position.X - dragStartMousePos.X
Dim offsetY As Integer = Cursor.Position.Y - dragStartMousePos.Y
Dim newFormX As Integer = dragStartFormPos.X + offsetX
Dim newFormY As Integer = dragStartFormPos.Y + offsetY
newFormX = Math.Max(0, Math.Min(newFormX, Screen.PrimaryScreen.WorkingArea.Width - Me.Width))
newFormY = Math.Max(0, Math.Min(newFormY, Screen.PrimaryScreen.WorkingArea.Height - Me.Height))
Me.Location = New System.Drawing.Point(newFormX, newFormY)
End Sub
Private Sub Form_MouseUp(sender As Object, e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
isDragging = False
Cursor = Cursors.Default
End If
End Sub
Private Sub Form_MouseClick(sender As Object, e As MouseEventArgs)
If isDragging Then Return
Dim formCenter As New System.Drawing.Point(Width \ 2, Height \ 2)
Dim mouseOffsetX As Integer = e.X - formCenter.X
Dim mouseOffsetY As Integer = e.Y - formCenter.Y
Dim distanceToCenter As Double = Math.Sqrt(mouseOffsetX ^ 2 + mouseOffsetY ^ 2)
Dim clickAngle As Double = Math.Atan2(mouseOffsetY, mouseOffsetX)
clickAngle += Math.PI / 2
If clickAngle < 0 Then clickAngle += 2 * Math.PI
Dim sectorCount As Integer = sectors.Count
Dim sectorAngleStep As Double = 2 * Math.PI / sectorCount
Dim targetSectorIndex As Integer = CInt(Math.Floor(clickAngle / sectorAngleStep)) Mod sectorCount
Dim targetSector As RadialSector = sectors(targetSectorIndex)
RaiseEvent ActionTriggered(targetSector.Action)
End Sub
Private Sub Form_Paint(sender As Object, e As PaintEventArgs)
Dim g As Graphics = e.Graphics
g.SmoothingMode = SmoothingMode.AntiAlias
Dim formCenter As New System.Drawing.Point(Width \ 2, Height \ 2)
Dim sectorCount As Integer = sectors.Count
Dim sectorAngleDeg As Single = 360.0F / sectorCount
For i As Integer = 0 To sectorCount - 1
Dim sector As RadialSector = sectors(i)
Using fillBrush As New SolidBrush(sector.FillColor)
Using sectorPath As New GraphicsPath()
sectorPath.AddPie(
formCenter.X - radiusOuter, formCenter.Y - radiusOuter,
radiusOuter * 2, radiusOuter * 2,
sectorAngleDeg * i,
sectorAngleDeg
)
sectorPath.AddPie(
formCenter.X - radiusInner, formCenter.Y - radiusInner,
radiusInner * 2, radiusInner * 2,
sectorAngleDeg * i,
sectorAngleDeg
)
sectorPath.FillMode = FillMode.Alternate
g.FillPath(fillBrush, sectorPath)
End Using
End Using
Dim sectorRadialAngleDeg As Single = sectorAngleDeg * i + sectorAngleDeg / 2
Dim sectorRadialAngleRad As Double = sectorRadialAngleDeg * Math.PI / 180.0
Dim textDistanceFromCenter As Integer = radiusInner + (radiusOuter - radiusInner) / 2
Dim textSize As SizeF = g.MeasureString(sector.Text, menuFont)
Dim textCenterX As Integer = CInt(formCenter.X + textDistanceFromCenter * Math.Cos(sectorRadialAngleRad))
Dim textCenterY As Integer = CInt(formCenter.Y + textDistanceFromCenter * Math.Sin(sectorRadialAngleRad))
Dim textRotateAngle As Single = If(textCenterX < formCenter.X,
sectorRadialAngleDeg + 180.0F,
sectorRadialAngleDeg)
Using textBrush As New SolidBrush(Color.Black)
Dim gState As GraphicsState = g.Save()
g.TranslateTransform(textCenterX, textCenterY)
g.RotateTransform(textRotateAngle)
g.DrawString(
sector.Text,
menuFont,
textBrush,
-textSize.Width \ 2,
-textSize.Height \ 2
)
g.Restore(gState)
End Using
Next
Using innerCircleWhiteBrush As New SolidBrush(Color.White)
g.FillEllipse(
innerCircleWhiteBrush,
formCenter.X - radiusInner, formCenter.Y - radiusInner,
radiusInner * 2, radiusInner * 2
)
End Using
Using innerCirclePen As New Pen(Color.Red, 2) With {.DashStyle = DashStyle.Dash}
g.DrawEllipse(
innerCirclePen,
formCenter.X - radiusInner, formCenter.Y - radiusInner,
radiusInner * 2, radiusInner * 2
)
Dim dragTextSize As SizeF = g.MeasureString("拖动", menuFont)
g.DrawString(
"拖动",
menuFont,
Brushes.Black,
formCenter.X - dragTextSize.Width \ 2,
formCenter.Y - dragTextSize.Height \ 2
)
End Using
Using outerCirclePen As New Pen(Color.Black, 2)
g.DrawEllipse(
outerCirclePen,
formCenter.X - radiusOuter, formCenter.Y - radiusOuter,
radiusOuter * 2, radiusOuter * 2
)
End Using
End Sub
Protected Overrides Sub Dispose(disposing As Boolean)
If disposing Then
If menuFont IsNot Nothing Then menuFont.Dispose()
RemoveHandler MouseDown, AddressOf Form_MouseDown
RemoveHandler MouseMove, AddressOf Form_MouseMove
RemoveHandler MouseUp, AddressOf Form_MouseUp
RemoveHandler MouseClick, AddressOf Form_MouseClick
RemoveHandler Paint, AddressOf Form_Paint
End If
MyBase.Dispose(disposing)
End Sub
Private Sub CloseMenu()
Me.Close()
End Sub
End Class
End Class[/hide]

[hide]Imports Autodesk.AutoCAD.Runtime 
Imports Autodesk.AutoCAD.ApplicationServices 
Imports Autodesk.AutoCAD.EditorInput 
 
Imports Autodesk.AutoCAD.Geometry 
Imports System.Drawing 
Imports System.Windows.Forms 
Imports System.Threading 
Imports System.Drawing.Drawing2D 
Imports Font = System.Drawing.Font 
 
Public Class RadialMenuDemo 
    Implements IExtensionApplication 
 
    Private Shared pendingAction As Action = Nothing 
    Private Shared targetCadPoint As Point3d = Point3d.Origin 
    Private Shared radialForm As RadialSectorMenuForm = Nothing 
 
    Public Sub Initialize() Implements IExtensionApplication.Initialize 
    End Sub 
 
    Public Sub Terminate() Implements IExtensionApplication.Terminate 
        If radialForm IsNot Nothing AndAlso Not radialForm.IsDisposed Then 
            If radialForm.InvokeRequired Then 
                radialForm.Invoke(New Action(Sub() radialForm.Close())) 
            Else 
                radialForm.Close() 
            End If 
            radialForm = Nothing 
        End If 
    End Sub 
 
    <CommandMethod("RadialMenu")> 
    Public Sub ShowRadialMenuCommand() 
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument 
        Dim ed As Editor = doc.Editor 
 
        If radialForm IsNot Nothing AndAlso Not radialForm.IsDisposed Then 
            If radialForm.InvokeRequired Then 
                radialForm.Invoke(New Action(Sub() radialForm.Close())) 
            Else 
                radialForm.Close() 
            End If 
            radialForm = Nothing 
        End If 
 
        Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "点击弹出可拖动轮盘菜单：" & vbCrLf & " - 拖动内圆移动菜单" & vbCrLf & " - 点击功能扇区执行命令" & vbCrLf & " - 点击内圆/外圆外关闭菜单") 
        If ppr.Status <> PromptStatus.OK Then 
            ed.WriteMessage(vbLf & "命令已取消。") 
            Return 
        End If 
        targetCadPoint = ppr.Value 
        Dim screenPoint As System.Drawing.Point = Cursor.Position 
 
        Dim sectors As New List(Of RadialSector) From { 
        New RadialSector("展点", Color.FromArgb(255, 80, 160, 220), AddressOf DrawZD), 
        New RadialSector("绘制图框", Color.FromArgb(255, 60, 140, 200), AddressOf DrawTK), 
        New RadialSector("绘剖面线", Color.FromArgb(255, 40, 120, 180), AddressOf DrawPMX), 
        New RadialSector("剖面计算", Color.FromArgb(255, 160, 120, 220), AddressOf DrawPMJS), 
        New RadialSector("剖面绘制", Color.FromArgb(255, 140, 100, 200), AddressOf DrawPMHZ), 
        New RadialSector("坐标标注", Color.FromArgb(255, 80, 200, 140), AddressOf ZBBZ), 
        New RadialSector("自动编号", Color.FromArgb(255, 150, 180, 120), AddressOf AutoBH), 
        New RadialSector("高程点内插", Color.FromArgb(255, 240, 140, 80), AddressOf CalcElevationByPoints), 
        New RadialSector("文本求和", Color.FromArgb(255, 223, 127, 60), AddressOf TextSummation), 
        New RadialSector("范围线", Color.FromArgb(255, 80, 220, 200), AddressOf AutoAlphaBoundary), 
        New RadialSector("生成坐标", Color.FromArgb(255, 60, 200, 180), AddressOf ZDfile), 
        New RadialSector("范围缩放", Color.FromArgb(255, 240, 200, 80), AddressOf OpenAll), 
        New RadialSector("打开所有", Color.FromArgb(255, 230, 191, 127), AddressOf DQtc), 
        New RadialSector("显示当前", Color.FromArgb(255, 220, 180, 40), AddressOf ZooE), 
        New RadialSector("关闭菜单", Color.FromArgb(255, 160, 160, 160), AddressOf CloseMenu) 
    } 
 
        Dim thread As New Thread(Sub() ShowNonModalDraggableForm(sectors, screenPoint)) With {.IsBackground = True} 
        thread.SetApartmentState(ApartmentState.STA) 
        thread.Start() 
    End Sub 
 
    Private Sub CloseMenu() 
        Dim docLock As DocumentLock = Core.Application.DocumentManager.MdiActiveDocument.LockDocument 
        If radialForm IsNot Nothing AndAlso Not radialForm.IsDisposed Then 
            If radialForm.InvokeRequired Then 
                radialForm.Invoke(New Action(Sub() radialForm.Close())) 
            Else 
                radialForm.Close() 
            End If 
        End If 
        docLock.Dispose() 
    End Sub 
 
 
    Private Sub DrawZD() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_ZD ", True, False, False) 
 
    End Sub 
 
    Private Sub DrawTK() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_Rec ", True, False, False) 
 
    End Sub 
 
    Private Sub DrawPMX() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_point ", True, False, False) 
 
    End Sub 
 
    Private Sub DrawPMJS() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_point ", True, False, False) 
 
    End Sub 
 
    Private Sub DrawPMHZ() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_point ", True, False, False) 
 
    End Sub 
 
    '坐标标注 
    Private Sub ZBBZ() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_ZBBZ ", True, False, False) 
 
    End Sub 
 
    '自动编号 
    Private Sub AutoBH() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_AutoBH ", True, False, False) 
 
    End Sub 
 
    '高程点内插 
    Private Sub CalcElevationByPoints() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() ' CAD获得焦点 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_CalcElevationByPoints ", True, False, False) 
 
    End Sub 
 
    '范围线 
    Private Sub AutoAlphaBoundary() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() ' CAD获得焦点 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_AutoAlphaBoundary ", True, False, False) 
 
    End Sub 
 
    '文本求和 求平均值 
    Private Sub TextSummation() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() ' CAD获得焦点 
 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_TextSummation ", True, False, False) 
 
    End Sub 
 
    '生成三维坐标文件 
    Private Sub ZDfile() 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        Dim ffName As New Zd_XyhFiles 
        ffName.Show() 
    End Sub 
 
    '打开所有 
    Private Sub OpenAll() 
 
    End Sub 
 
    '只显示当前层 
    Private Sub DQtc() 
        DQtc() 
 
    End Sub 
 
    ' 范围缩放 
    Private Sub ZooE() 
        Core.Application.DocumentManager.MdiActiveDocument.Window.Focus() ' CAD获得焦点 
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument 
        acDoc.SendStringToExecute("_Zoom E ", True, False, False) 
    End Sub 
 
 
 
    '=============================================================================================== 
 
    Private Sub ShowNonModalDraggableForm(sectors As List(Of RadialSector), screenPos As System.Drawing.Point) 
        Try 
            System.Windows.Forms.Application.SetCompatibleTextRenderingDefault(False) 
            radialForm = New RadialSectorMenuForm(sectors) With { 
                .StartPosition = FormStartPosition.Manual 
            } 
            radialForm.Location = New System.Drawing.Point( 
                screenPos.X - radialForm.Width \ 2, 
                screenPos.Y - radialForm.Height \ 2 
            ) 
 
            ' 绑定窗体事件（仅保留ActionTriggered，简化事件机制） 
            AddHandler radialForm.FormClosed, AddressOf RadialForm_Closed 
            AddHandler radialForm.ActionTriggered, AddressOf OnActionTriggered 
 
            radialForm.Show() 
            System.Windows.Forms.Application.Run() 
        Catch ex As Exception 
            System.Windows.Forms.MessageBox.Show( 
                $"菜单加载错误：{ex.Message}", "错误提示", 
                System.Windows.Forms.MessageBoxButtons.OK, System.Windows.Forms.MessageBoxIcon.Error 
            ) 
        End Try 
    End Sub 
 
    Private Sub RadialForm_Closed(sender As Object, e As FormClosedEventArgs) 
        radialForm = Nothing 
        System.Windows.Forms.Application.ExitThread() 
    End Sub 
 
    Private Sub OnActionTriggered(action As Action) 
        If action Is Nothing Then Return 
        pendingAction = action 
        AddHandler Autodesk.AutoCAD.ApplicationServices.Application.Idle, AddressOf ExecuteActionOnCADMainThread 
    End Sub 
 
    Private Sub ExecuteActionOnCADMainThread(sender As Object, e As EventArgs) 
        RemoveHandler Autodesk.AutoCAD.ApplicationServices.Application.Idle, AddressOf ExecuteActionOnCADMainThread 
 
        If pendingAction IsNot Nothing Then 
            pendingAction.Invoke() 
            pendingAction = Nothing 
        End If 
    End Sub 
 
    ' ----------------------  ---------------------- 
    Friend Class RadialSector 
        Public Property Text As String 
        Public Property FillColor As Color 
        Public Property Action As Action 
        Public Sub New(text As String, fillColor As Color, action As Action) 
            Me.Text = text 
            Me.FillColor = fillColor 
            Me.Action = action 
        End Sub 
    End Class 
 
    ' ----------------------  ---------------------- 
    Friend Class RadialSectorMenuForm 
        Inherits Form 
 
        Public Event ActionTriggered(action As Action) 
 
        Private isDragging As Boolean = False 
        Private dragStartMousePos As Point 
        Private dragStartFormPos As Point 
 
        Private ReadOnly sectors As List(Of RadialSector) 
        Private ReadOnly radiusOuter As Integer = 140 
        Private ReadOnly radiusInner As Integer = 40 
        Private ReadOnly menuFont As Font 
 
        Public Sub New(sectors As List(Of RadialSector)) 
            Me.sectors = sectors 
            FormBorderStyle = FormBorderStyle.None 
            ShowInTaskbar = False 
            TopMost = True 
            BackColor = Color.Magenta 
            TransparencyKey = Color.Magenta 
            DoubleBuffered = True 
            Size = New Size(radiusOuter * 2, radiusOuter * 2) 
            menuFont = New Font("宋体", 10, FontStyle.Bold) 
 
 
            AddHandler MouseDown, AddressOf Form_MouseDown 
            AddHandler MouseMove, AddressOf Form_MouseMove 
            AddHandler MouseUp, AddressOf Form_MouseUp 
            AddHandler MouseClick, AddressOf Form_MouseClick 
            AddHandler Paint, AddressOf Form_Paint 
        End Sub 
 
 
        Private Sub Form_MouseDown(sender As Object, e As MouseEventArgs) 
            If e.Button <> MouseButtons.Left Then Return 
 
            Dim formCenter As New System.Drawing.Point(Width \ 2, Height \ 2) 
            Dim mouseOffsetX As Integer = e.X - formCenter.X 
            Dim mouseOffsetY As Integer = e.Y - formCenter.Y 
            Dim distanceToCenter As Double = Math.Sqrt(mouseOffsetX ^ 2 + mouseOffsetY ^ 2) 
 
            If distanceToCenter <= radiusInner Then 
                isDragging = True 
                dragStartMousePos = Cursor.Position 
                dragStartFormPos = Me.Location 
                Cursor = Cursors.Hand 
            End If 
        End Sub 
 
 
        Private Sub Form_MouseMove(sender As Object, e As MouseEventArgs) 
            If Not isDragging Then Return 
 
            Dim offsetX As Integer = Cursor.Position.X - dragStartMousePos.X 
            Dim offsetY As Integer = Cursor.Position.Y - dragStartMousePos.Y 
 
            Dim newFormX As Integer = dragStartFormPos.X + offsetX 
            Dim newFormY As Integer = dragStartFormPos.Y + offsetY 
 
 
            newFormX = Math.Max(0, Math.Min(newFormX, Screen.PrimaryScreen.WorkingArea.Width - Me.Width)) 
            newFormY = Math.Max(0, Math.Min(newFormY, Screen.PrimaryScreen.WorkingArea.Height - Me.Height)) 
 
            Me.Location = New System.Drawing.Point(newFormX, newFormY) 
        End Sub 
 
 
        Private Sub Form_MouseUp(sender As Object, e As MouseEventArgs) 
            If e.Button = MouseButtons.Left Then 
                isDragging = False 
                Cursor = Cursors.Default 
            End If 
        End Sub 
 
        Private Sub Form_MouseClick(sender As Object, e As MouseEventArgs) 
            If isDragging Then Return 
 
            Dim formCenter As New System.Drawing.Point(Width \ 2, Height \ 2) 
            Dim mouseOffsetX As Integer = e.X - formCenter.X 
            Dim mouseOffsetY As Integer = e.Y - formCenter.Y 
            Dim distanceToCenter As Double = Math.Sqrt(mouseOffsetX ^ 2 + mouseOffsetY ^ 2) 
 
 
            Dim clickAngle As Double = Math.Atan2(mouseOffsetY, mouseOffsetX) 
            clickAngle += Math.PI / 2 
            If clickAngle < 0 Then clickAngle += 2 * Math.PI 
 
            Dim sectorCount As Integer = sectors.Count 
            Dim sectorAngleStep As Double = 2 * Math.PI / sectorCount 
            Dim targetSectorIndex As Integer = CInt(Math.Floor(clickAngle / sectorAngleStep)) Mod sectorCount 
            Dim targetSector As RadialSector = sectors(targetSectorIndex) 
 
 
            RaiseEvent ActionTriggered(targetSector.Action) 
        End Sub 
 
 
        Private Sub Form_Paint(sender As Object, e As PaintEventArgs) 
            Dim g As Graphics = e.Graphics 
            g.SmoothingMode = SmoothingMode.AntiAlias 
            Dim formCenter As New System.Drawing.Point(Width \ 2, Height \ 2) 
            Dim sectorCount As Integer = sectors.Count 
            Dim sectorAngleDeg As Single = 360.0F / sectorCount 
 
 
            For i As Integer = 0 To sectorCount - 1 
                Dim sector As RadialSector = sectors(i) 
 
                Using fillBrush As New SolidBrush(sector.FillColor) 
                    Using sectorPath As New GraphicsPath() 
 
                        sectorPath.AddPie( 
                    formCenter.X - radiusOuter, formCenter.Y - radiusOuter, 
                    radiusOuter * 2, radiusOuter * 2, 
                    sectorAngleDeg * i, 
                    sectorAngleDeg 
                ) 
 
                        sectorPath.AddPie( 
                    formCenter.X - radiusInner, formCenter.Y - radiusInner, 
                    radiusInner * 2, radiusInner * 2, 
                    sectorAngleDeg * i, 
                    sectorAngleDeg 
                ) 
                        sectorPath.FillMode = FillMode.Alternate 
                        g.FillPath(fillBrush, sectorPath) 
                    End Using 
                End Using 
 
 
                Dim sectorRadialAngleDeg As Single = sectorAngleDeg * i + sectorAngleDeg / 2 
                Dim sectorRadialAngleRad As Double = sectorRadialAngleDeg * Math.PI / 180.0 
                Dim textDistanceFromCenter As Integer = radiusInner + (radiusOuter - radiusInner) / 2 
                Dim textSize As SizeF = g.MeasureString(sector.Text, menuFont) 
 
                Dim textCenterX As Integer = CInt(formCenter.X + textDistanceFromCenter * Math.Cos(sectorRadialAngleRad)) 
                Dim textCenterY As Integer = CInt(formCenter.Y + textDistanceFromCenter * Math.Sin(sectorRadialAngleRad)) 
 
                Dim textRotateAngle As Single = If(textCenterX < formCenter.X, 
                                          sectorRadialAngleDeg + 180.0F, 
                                          sectorRadialAngleDeg) 
 
                Using textBrush As New SolidBrush(Color.Black) 
                    Dim gState As GraphicsState = g.Save() 
 
                    g.TranslateTransform(textCenterX, textCenterY) 
                    g.RotateTransform(textRotateAngle) 
                    g.DrawString( 
                sector.Text, 
                menuFont, 
                textBrush, 
                -textSize.Width \ 2, 
                -textSize.Height \ 2 
            ) 
 
                    g.Restore(gState) 
                End Using 
            Next 
 
            Using innerCircleWhiteBrush As New SolidBrush(Color.White) 
                g.FillEllipse( 
            innerCircleWhiteBrush, 
            formCenter.X - radiusInner, formCenter.Y - radiusInner, 
            radiusInner * 2, radiusInner * 2 
        ) 
            End Using 
 
            Using innerCirclePen As New Pen(Color.Red, 2) With {.DashStyle = DashStyle.Dash} 
                g.DrawEllipse( 
            innerCirclePen, 
            formCenter.X - radiusInner, formCenter.Y - radiusInner, 
            radiusInner * 2, radiusInner * 2 
        ) 
                Dim dragTextSize As SizeF = g.MeasureString("拖动", menuFont) 
                g.DrawString( 
            "拖动", 
            menuFont, 
            Brushes.Black, 
            formCenter.X - dragTextSize.Width \ 2, 
            formCenter.Y - dragTextSize.Height \ 2 
        ) 
            End Using 
 
            Using outerCirclePen As New Pen(Color.Black, 2) 
                g.DrawEllipse( 
            outerCirclePen, 
            formCenter.X - radiusOuter, formCenter.Y - radiusOuter, 
            radiusOuter * 2, radiusOuter * 2 
        ) 
            End Using 
        End Sub 
 
        Protected Overrides Sub Dispose(disposing As Boolean) 
            If disposing Then 
                If menuFont IsNot Nothing Then menuFont.Dispose() 
                RemoveHandler MouseDown, AddressOf Form_MouseDown 
                RemoveHandler MouseMove, AddressOf Form_MouseMove 
                RemoveHandler MouseUp, AddressOf Form_MouseUp 
                RemoveHandler MouseClick, AddressOf Form_MouseClick 
                RemoveHandler Paint, AddressOf Form_Paint 
            End If 
            MyBase.Dispose(disposing) 
        End Sub 
 
        Private Sub CloseMenu() 
            Me.Close() 
        End Sub 
    End Class 
End Class[/hide]

网友答:

qifeifei 发表于 2025-11-2 13:33
太强大了直接发布源码

测试过了没有？看下兼容哪些版本？

网友答:

pengbin 发表于 2025-11-2 13:47
测试过了没有？看下兼容哪些版本？

没有啊不打算弄这个我用不上.

网友答: 太强大了直接发布源码

网友答: 必须顶一下，这个好。

网友答: 强呀。如何使用呀？

网友答: 功能很强大，先收藏

网友答: 提供源码的，必需顶上

网友答: 营销没有别人厉害呀

上一篇：變更圖元的屬性

下一篇：没有了