在CASS下根据所选择的实体编码、图层进行闭合操作

loading 分享 2026-8-11 下载文档

08-11-03 15:56:19 http://blog.sina.com.cn/luojiandan

核心提示：把代码copy到代码窗口中即可。

把代码copy到代码窗口中即可。代码如下：

Public Sub ClosedByCode() '根据实体编码闭合实体

'创建空白选择集

Dim SelSet As AcadSelectionSet Set SelSet = CreateSelectionSet

'建立选择集过滤器 Dim TypeArray As Variant Dim DateArray As Variant

BuildFilter TypeArray, DateArray, 0, \ '0 实体类型 '8 实体所在图层

'过滤出所要选择的图块

SelSet.Select acSelectionSetAll, , , TypeArray, DateArray Dim LwPObj As AcadLWPolyline Dim I As Integer

For I = 0 To SelSet.Count - 1 Set LwPObj = SelSet.Item(I) Dim xDataOut As Variant Dim xTypeOut As Variant

LwPObj.GetXData \ Select Case xDataOut(1)

Case \ \ '**************************************************************

' Code 名称

' 141101 一般房屋

' 141111 砼房屋

' 141121 砖房屋

' 141131 铁房屋

' 141141 钢房屋

' 141151 木房屋

' 141161 混房屋

' 141103 小比例吃房屋

' 141200 简单房屋

' 141300 建筑房屋

' 141400 破坏房屋

' 141500 棚房

' 141600 架空房屋

' 141700 廊房

'**************************************************************

'执行闭合操作

If LwPObj.Closed = False Then LwPObj.Closed = True End Select

If UBound(LwPObj.Coordinates) < 4 Then LwPObj.Delete Next

ThisDrawing.Application.Update '刷新操作 End Sub

'创建过滤器的函数

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

'创建空间选择集的函数

Public Function CreateSelectionSet(Optional ssName As String = \ectionSet

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

在CASS下根据所选择的实体编码、图层进行闭合操作.doc 将本文的Word文档下载到电脑

下载这篇word文档