使用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