[原创]：为Autocad2000添加双击相应

oscar2000

为Autocad2000添加双击相应,代码很短,但是很实用,呵呵.

暂时只做了文本编辑功能,其它功能没想到,各位有什么好的建议请更帖,以后酌情加上.

Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
    If PickfirstSelectionSet.Count <> 1 Then Exit Sub
    Select Case PickfirstSelectionSet.Item(0).ObjectName
           Case "AcDbText", "AcDbMText", "AcDbAlignedDimension", "AcDbRotatedDimension", "AcDbDiametricDimension", "AcDbRadialDimension", "AcDb2LineAngularDimension", "AcDb3PointAngularDimension"
                ActiveDocument.SendCommand "_ed" & vbCr
                ActiveDocument.SendCommand vbCr
           Case "AcDbBlockReference"
                If PickfirstSelectionSet.Item(0).HasAttributes Then
                   ActiveDocument.SendCommand "_attedit" & vbCr & "(handent " & Chr(34) & PickfirstSelectionSet.Item(0).Handle & Chr(34) & ")" & vbCr
                 Else
                   Exit Sub
                End If
           Case Else
    End Select
End Sub