'Detail View Circle' VBA rule hangs when interrupted by Escape key

'Detail View Circle' VBA rule hangs when interrupted by Escape key

checkcheck_master
Advocate Advocate
223 Views
0 Replies
Message 1 of 1

'Detail View Circle' VBA rule hangs when interrupted by Escape key

checkcheck_master
Advocate
Advocate

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

 

0 Likes
224 Views
0 Replies
Replies (0)