windshell 发表于 2008-10-16 17:46:00

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

本帖最后由 作者 于 2008-10-17 0:08:28 编辑

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 发表于 2008-10-16 21:50:00

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

windshell 发表于 2008-10-17 00:05:00

本帖最后由 作者 于 2008-10-17 0:26:11 编辑

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

'双击块实现调用自定议函数 配合 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
页: [1]
查看完整版本: [求助]双击事件-选中块时无法取得对像---自己解决使用选择集加捕捉点获得对像