Code:
<DllImport("User32.dll")> _
Private Shared Function GetDC(ByVal hwnd As IntPtr) As IntPtr
End Function <DllImport("user32.dll")> _
Private Shared Function ReleaseDC(ByVal hWnd As IntPtr) As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function ClientToScreen(ByVal hWnd As IntPtr, ByRef lpPoint As Point) As Boolean
End Function
<CommandMethod("dDraw")> _
Sub dDraw()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim Pt1 As Point
Dim Pt2 As Point
Dim ppr As PromptPointResult
' Ask the user for the screen window to draw
' Get the first point of the capture window,
ppr = ed.GetPoint("Select first point of window: ")
' Loop if settings were modified
If (ppr.Status = PromptStatus.OK) Then
' Now we're ready to select the second point
Dim first As Point3d = ppr.Value
ppr = ed.GetCorner("" & vbLf & "Select second point of window: ", first)
If (ppr.Status <> PromptStatus.OK) Then
Return
End If
Dim second As Point3d = ppr.Value
' Generate screen coordinate points based on the
' drawing points selected
' First we get the viewport number
Dim vp As Short = CType(Application.GetSystemVariable("CVPORT"), Short)
' Then the handle to the current drawing window
Dim hWnd As IntPtr = doc.Window.Handle
' Now calculate the selected corners in screen coordinates
Pt1 = ScreenFromDrawingPoint(ed, hWnd, first, vp, True)
Pt2 = ScreenFromDrawingPoint(ed, hWnd, second, vp, True)
'the rectangle will be allways drawn from top left to right down
Dim X As Integer
If Pt1.X > Pt2.X Then
X = Pt2.X
Else
X = Pt1.X
End If
Dim Y As Integer
If Pt1.Y > Pt2.Y Then
Y = Pt2.Y
Else
Y = Pt1.Y
End If
Dim Width As Integer = Math.Abs(Pt2.X - Pt1.X)
Dim Height As Integer = Math.Abs(Pt2.Y - Pt1.Y)
Dim Rect As New Rectangle(X, Y, Width, Height)
Dim DesktopDC As IntPtr = GetDC(IntPtr.Zero)
Dim Graphic As Graphics = Graphics.FromHdc(DesktopDC)
Dim Brush As SolidBrush = New SolidBrush(Color.Red)
Graphic.FillRectangle(Brush, Rect)
Graphic.Dispose()
ReleaseDC(DesktopDC)
End If
End Sub
Private Shared Function ScreenFromDrawingPoint(ByVal ed As Editor, ByVal hWnd As IntPtr, ByVal pt As Point3d, ByVal vpNum As Short, ByVal useUcs As Boolean) As Point
' Transform from UCS to WCS, if needed
Dim wcsPt As Point3d = If(useUcs, pt.TransformBy(ed.CurrentUserCoordinateSystem), pt)
'' Then get the screen coordinates within the client
'' and translate these for the overall screen
Dim res As Point = ed.PointToScreen(wcsPt, vpNum)
ClientToScreen(hWnd, res)
Return res
End Function