- Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
- Dim SS As AcadSelectionSet, H As AcadHatch, FT(0) As Integer, FD(0) As Variant
- '新建选择集
- Set SS = ThisDrawing.SelectionSets.Add("SS")
- '设置选择集过滤器为图案填充对象
- FT(0) = 0
- FD(0) = "HATCH"
- '在双击的点上选择图案填充对象
- SS.SelectAtPoint PickPoint, FT, FD
- '如果选择有效则把该图案填充对象赋值给变量
- If SS.Count > 0 Then
- Set H = SS(0)
- End If
- '删除选择集
- SS.Delete
- '后面如何打开对话框及根据用户要求修改对象属性等代码可自行编写
- End Sub
|