[VBA]为Autocad2000添加双击相应

mikewolf2k · 发表于 2004-4-12 18:48:00

为2000添加双击相应,代码很短,但是很实用,呵呵.
暂时只做了文本编辑功能,其它功能没想到,各位有什么好的建议请更帖,以后酌情加上.
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