Message 1 of 1
'Detail View Circle' VBA rule hangs when interrupted by Escape key
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello.
I use the VBA rules 'Detail View Circle' and 'Detail View Box' to my full satisfaction.
These ask the user to select a view, the center of the fence and a point to drop the detail view.
Small thing, if the rule is interrupted by means of Escape-key, it will hang, see image.
I have no idea how to get around this.
Can an event when Escape is hit?
Public Sub Detail_View_Circle_VBA()
' Set a reference to the drawing document.
' This assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
'----------------------------------------------------------------------------------------------------
' Undo Wrapper
Dim trans As Transaction
Set trans = ThisApplication.TransactionManager.StartTransaction(oDrawDoc, "Do your thing")
'----------------------------------------------------------------------------------------------------
' Set a reference to the active sheet.
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
' Select a drawing view
Dim oDrawingView As DrawingView
Set oDrawingView = ThisApplication.CommandManager.Pick(kDrawingViewFilter, "Select a drawing view.")
' Select the center of the circular fence
Dim getPoint As New clsGetPoint
Dim oCenterPoint As Point2d
Set oCenterPoint = getPoint.GetDrawingPoint("Please select the center point of the fence", kLeftMouseButton)
' Select the place where the detailed view need to be placed
Dim oPoint As Point2d
Set oPoint = getPoint.GetDrawingPoint("Please select the center location for the detailed view", kLeftMouseButton)
' Create the detail view
Dim oDetailView As DetailDrawingView
Set oDetailView = oSheet.DrawingViews.AddDetailView(oDrawingView, oPoint, DrawingViewStyleEnum.kFromBaseDrawingViewStyle, True, oCenterPoint, 0.5, , oDrawingView.Scale * 2, False, " ")
' Set breakline to smooth
oDetailView.IsBreakLineSmooth = True
' Show full detail boundary
oDetailView.DisplayFullBoundary = True
' Show connection line
oDetailView.DisplayConnectionLine = True
' ' Ask for an Attach Point for a fixed detailview
' Dim oAttachPointSel As Variant
' Set oAttachPointSel = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllEntitiesFilter, "Please select geometry to Attach the drawing view to or ESC")
' Dim oAttachPoint As GeometryIntent
' oAttachPoint = oAttachPointSel
'
' oDetailView.AttachPoint = oAttachPoint
' Set detailview to "Parts"
' this assumes that there is an detailview called "Parts", if not, delete this line
On Error Resume Next
Call oDetailView.SetDesignViewRepresentation("Parts", False)
'----------------------------------------------------------------------------------------------------
' Undo Wrapper
trans.End
'----------------------------------------------------------------------------------------------------
End Sub
Public Sub Detail_View_Box_VBA()
' Set a reference to the drawing document.
' This assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
'----------------------------------------------------------------------------------------------------
' Undo Wrapper
Dim trans As Transaction
Set trans = ThisApplication.TransactionManager.StartTransaction(oDrawDoc, "Do your thing")
'----------------------------------------------------------------------------------------------------
' Set a reference to the active sheet.
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
' Select a drawing view
Dim oDrawingView As DrawingView
Set oDrawingView = ThisApplication.CommandManager.Pick(kDrawingViewFilter, "Select a drawing view.")
' Select the center of the circular fence
Dim getPoint As New clsGetPoint
Dim oCenterPoint As Point2d
Set oCenterPoint = getPoint.GetDrawingPoint("Please select the center point of the fence", kLeftMouseButton)
' Select the place where the detailed view need to be placed
Dim oPoint As Point2d
Set oPoint = getPoint.GetDrawingPoint("Please select the center location for the detailed view", kLeftMouseButton)
Dim oDetailView As DetailDrawingView
' Create the Circle detail view
'Set oDetailView = oSheet.DrawingViews.AddDetailView(oDrawingView, oPoint, DrawingViewStyleEnum.kFromBaseDrawingViewStyle, True, oCenterPoint, 0.5, , oDrawingView.Scale * 2, False, " ")
' Arbitrarily find an arc within the selected drawing view.
' The detail view will include this arc.
Dim oCurve As DrawingCurve
Dim oArcCurve As DrawingCurve
For Each oCurve In oDrawingView.DrawingCurves
If oCurve.CurveType = kCircularArcCurve Then
Set oArcCurve = oCurve
Exit For
End If
Next
If oArcCurve Is Nothing Then
MsgBox "No arc was found in the selected drawing view. Exiting rule."
Exit Sub
End If
' Use the range of the arc in sheet space to calculate the detail view box.
Dim oCornerOne As Point2d
Set oCornerOne = oArcCurve.Evaluator2D.RangeBox.MinPoint
oCornerOne.x = oCenterPoint.x - 0.5
oCornerOne.y = oCenterPoint.y - 0.5
Dim oCornerTwo As Point2d
Set oCornerTwo = oArcCurve.Evaluator2D.RangeBox.MaxPoint
oCornerTwo.x = oCenterPoint.x + 0.5
oCornerTwo.y = oCenterPoint.y + 0.5
Debug.Print "oCenterPoint.X : " & oCenterPoint.x
Debug.Print "oCenterPoint.Y : " & oCenterPoint.y
Debug.Print ""
Debug.Print "oCornerOne.X : " & oCornerOne.x
Debug.Print "oCornerOne.Y : " & oCornerOne.y
Debug.Print ""
Debug.Print "oCornerTwo.X : " & oCornerTwo.x
Debug.Print "oCornerTwo.Y : " & oCornerTwo.y
Debug.Print ""
Debug.Print ""
' Create the detail view with a rectangular box
Set oDetailView = oSheet.DrawingViews.AddDetailView(oDrawingView, oPoint, DrawingViewStyleEnum.kFromBaseDrawingViewStyle, False, oCornerOne, oCornerTwo, , oDrawingView.Scale * 2, False, " ")
' Set breakline to smooth
oDetailView.IsBreakLineSmooth = True
' Show full detail boundary
oDetailView.DisplayFullBoundary = True
' Show connection line
oDetailView.DisplayConnectionLine = True
' ' Ask for an Attach Point for a fixed detailview
' Dim oAttachPointSel As Variant
' Set oAttachPointSel = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllEntitiesFilter, "Please select geometry to Attach the drawing view to or ESC")
' Dim oAttachPoint As GeometryIntent
' oAttachPoint = oAttachPointSel
'
' oDetailView.AttachPoint = oAttachPoint
' Set detailview to "Parts"
' this assumes that there is an detailview called "Parts", if not, delete this line
On Error Resume Next
Call oDetailView.SetDesignViewRepresentation("Parts", False)
'----------------------------------------------------------------------------------------------------
' Undo Wrapper
trans.End
'----------------------------------------------------------------------------------------------------
End Sub
Private WithEvents m_interaction As InteractionEvents
Private WithEvents m_mouse As MouseEvents
Private m_position As Point2d
Private m_button As MouseButtonEnum
Private m_continue As Boolean
Public Function GetDrawingPoint(Prompt As String, Button As MouseButtonEnum) As Point2d
On Error Resume Next
Set m_position = Nothing
m_button = Button
Set m_interaction = ThisApplication.CommandManager.CreateInteractionEvents
Set m_mouse = m_interaction.MouseEvents
m_interaction.StatusBarText = Prompt
m_interaction.Start
m_continue = True
Do
DoEvents
Loop While m_continue
On Error Resume Next
m_interaction.Stop
Set GetDrawingPoint = m_position
End Function
Private Sub m_mouse_OnMouseClick(ByVal Button As MouseButtonEnum, ByVal ShiftKeys As ShiftStateEnum, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
If Button = m_button Then
Set m_position = ThisApplication.TransientGeometry.CreatePoint2d(ModelPosition.x, ModelPosition.y)
End If
m_continue = False
End Sub