[求助]双击事件-选中块时无法取得对像---自己解决使用选择集加捕捉点获得对像

windshell

2. Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
3.     ' MsgBox PickfirstSelectionSet.COUNT '''选中块时为0
4.    If PickfirstSelectionSet.COUNT <> 1 Then Exit Sub
5. Select Case PickfirstSelectionSet.Item(0).ObjectName
6.            Case "AcDbText", "AcDbMText"  ''
7.                MsgBox "Text"
8.            Case "AcDbBlockReference"
9.               MsgBox "Block"
10.                 If PickfirstSelectionSet.Item(0).HasAttributes Then
11.                     MsgBox "属性快"
12.                 Else
13.                    Exit Sub
14.                 End If
15.             Case "AcadCircle"
16.                  MsgBox "Circle"
17.                
18.            Case Else
19.     End Select
20. End Sub

Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)     ' MsgBox PickfirstSelectionSet.COUNT '''选中块时为0    If PickfirstSelectionSet.COUNT <> 1 Then Exit Sub Select Case PickfirstSelectionSet.Item(0).ObjectName            Case "AcDbText", "AcDbMText"  ''                MsgBox "Text"            Case "AcDbBlockReference"               MsgBox "Block"                 If PickfirstSelectionSet.Item(0).HasAttributes Then                     MsgBox "属性快"                 Else                    Exit Sub                 End If             Case "AcadCircle"                  MsgBox "Circle"                            Case Else     End Select End Sub

代码如上,为什么如果在块上双击时选择集为空.望高手能告知,在文字,直线等上双击均正常

windshell

没人回答.或者在你们的机子上运行正常?

windshell

没人帮忙啊,自己解决一下.有高手能解决一下用上面的方法实现吗

3. '双击块实现调用自定议函数 配合 undefine mtedit 并自定mtedit函数为空操作,可蔽屏系统默认修改属性
4. Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
5.     On Error Resume Next
6.     Dim ssset As AcadSelectionSet
7.     Set ssset= ThisDrawing.SelectionSets.Add("SSET1")
8.     Dim point(0 To 2) As Double
9.     Dim gpCode(0) As Integer
10.     Dim dataValue(0) As Variant
11.     gpCode(0) = 0
12.     dataValue(0) = "Insert"
13.      ssset.SelectAtPoint PickPoint, gpCode, dataValue
14.      If ssset.COUNT <> 0 Then
15.         If ssset.Item(0).HasAttributes Then
16.         MsgBox ssset.Item(0).ObjectName & "带属性"
17.         Else
18.             MsgBox ssset.Item(0).ObjectName & "不带属性"
19.         End If
20.       Else
21.         MsgBox " 没有选择块 "
22.      End If
23.      ssset.Clear
24.      ssset.Delete
25.      Set ssset = Nothing
26. End Sub

'双击块实现调用自定议函数 配合 undefine mtedit 并自定mtedit函数为空操作,可蔽屏系统默认修改属性 Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)     On Error Resume Next     Dim ssset As AcadSelectionSet     Set ssset= ThisDrawing.SelectionSets.Add("SSET1")     Dim point(0 To 2) As Double     Dim gpCode(0) As Integer     Dim dataValue(0) As Variant     gpCode(0) = 0     dataValue(0) = "Insert"      ssset.SelectAtPoint PickPoint, gpCode, dataValue      If ssset.COUNT <> 0 Then         If ssset.Item(0).HasAttributes Then         MsgBox ssset.Item(0).ObjectName & "带属性"         Else             MsgBox ssset.Item(0).ObjectName & "不带属性"         End If       Else         MsgBox " 没有选择块 "      End If      ssset.Clear      ssset.Delete      Set ssset = Nothing End Sub