- 积分
- 73549
- 明经币
- 个
- 注册时间
- 2001-6-7
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2003-3-29 20:21:00
|
显示全部楼层
程序在VBA中调试没有问题啊,你看看
本帖最后由 mccad 于 2003-3-29 20:21:55 编辑
Sub SelectByFence()
Dim returnobj1 As Object
Dim basepnt1 As Variant
Dim lay As String
Dim mode As Integer
Dim ppoint(0 To 5) As Double
Dim paom As AcadSelectionSet
Set paom = CreateSelectionSet
Utility.GetEntity returnobj1, basepnt1, "请选一条等高线,确定等高线所在的图层"
lay = returnobj1.Layer
mode = acSelectionSetFence
Dim FilterType(1) As Integer
Dim FilterData(1) As Variant
FilterType(0) = 0
FilterData(0) = "lwpolyline,spline"
FilterType(1) = 8
FilterData(1) = lay '"DX-DGX" '
Debug.Print lay
ppoint(0) = 1
ppoint(1) = 1
ppoint(2) = 0
ppoint(3) = 10
ppoint(4) = 10
ppoint(5) = 0
paom.SelectByPolygon mode, ppoint, FilterType, FilterData
End Sub
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function |
|