- 积分
- 73549
- 明经币
- 个
- 注册时间
- 2001-6-7
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2002-8-17 19:37:00
|
显示全部楼层
如内程序,试试看
Sub AddRegFromPLline()
Dim ftype As Variant
Dim fdata As Variant
Dim PlineEnt(0) As AcadEntity
Dim PlineSet As AcadSelectionSet
BuildFilter ftype, fdate, 0, "*POLYLINE"
Set PlineSet = CreateSelectionSet
PlineSet.SelectOnScreen ftype, fdate
Dim Entry As AcadEntity
On Error Resume Next
For Each Entry In PlineSet
Set PlineEnt(0) = Entry
ThisDrawing.ModelSpace.AddRegion PlineEnt
Next Entry
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
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
Dim ftype() As Integer, fdata()
Dim index As Long, i As Long
index = LBound(gCodes) - 1
For i = LBound(gCodes) To UBound(gCodes) Step 2
index = index + 1
ReDim Preserve ftype(0 To index)
ReDim Preserve fdata(0 To index)
ftype(index) = CInt(gCodes(i))
fdata(index) = gCodes(i + 1)
Next
typeArray = ftype: dataArray = fdata
End Sub |
|