使用VBA在CAD中删除选中对象中的文字和标注


代码如下
 
Sub deleteTextAndDimension()
    
    Dim oSS As Object
    On Error Resume Next
    If Not IsNull(ThisDrawing.SelectionSets.Item("Wolf")) Then
        Set oSS = ThisDrawing.SelectionSets.Item("wolf")
        oSS.Delete
    End If
    Set oSS = ThisDrawing.SelectionSets.Add("wolf")

    On Error GoTo catchError
    Dim fType() As Integer
    Dim fData As Variant
      strFilterType = "-4,0,0,-4"
    strFilterData = "<or,text,dimension,or>"
    Call createFilter(fType, fData, strFilterType, strFilterData)

    oSS.SelectOnScreen fType, fData
    oSS.Highlight ture
    oSS.Erase
    oSS.Delete

exitSub:
    Exit Sub
catchError:
    ' add error handling
    If Err Then
        Err.Clear
        MsgBox Err.Description
    End If
    
End Sub

Sub createFilter(fType, fData, strFilterType, strFilterData)
    '// add declarations
    On Error GoTo catchError
    arrFilterType = Split(strFilterType, ",")
    arrFilterData = Split(strFilterData, ",")
    If UBound(arrFilterType) = UBound(arrFilterData) Then
        intFilterCount = UBound(arrFilterType)
        ReDim fType(intFilterCount)
        ReDim fData(intFilterCount)
        For i = 0 To UBound(arrFilterType)
            fType(i) = arrFilterType(i)
            fData(i) = arrFilterData(i)
        Next i
    Else
        GoTo exitFunction
    End If

exitFunction:
    Exit Sub
catchError:
    '// add error handling
    GoTo exitFunction
End Sub


免责声明!

本站转载的文章为个人学习借鉴使用,本站对版权不负任何法律责任。如果侵犯了您的隐私权益,请联系本站邮箱yoyou2525@163.com删除。



 
粤ICP备18138465号  © 2018-2025 CODEPRJ.COM