不知道是什么回事？

Sub Trim()
    Dim acadapp As AcadApplication
    Dim acaddoc As AcadDocument
    '此句用于VBA
    Set acadapp = ThisDrawing.Application
    '此名用于VB
    'Set acadapp = connectcad(acadapp)
    Set acaddoc = acadapp.ActiveDocument
    '此句用于VB
    'AppActivate acadapp.Caption '让CAD得到焦点
    
    
    Dim Pnt1 As Variant
    Dim entObj1 As AcadEntity
    acaddoc.Utility.GetEntity entObj1, Pnt1, "选择修剪边界："
    Dim det1 As String
    det1 = axEnt2lspEnt(entObj1)
    
    Dim entObjOff As AcadEntity
    Dim entObjOffs As Variant
    
    '控制偏移的距离和方向的参数
    Dim OffDist As Double
    OffDist = 0.5
    entObjOffs = entObj1.Offset(OffDist)
    Set entObjOff = entObjOffs(0)
    
    Dim Pnt2 As Variant
    Dim entObj2 As AcadEntity
    
    Dim sle1 As AcadSelectionSet
    
    
    On Error Resume Next
    
    Set sle1 = acaddoc.SelectionSets.Item("sle1")
    sle1.Clear
    If Err Then
    Err.Clear
    Set sle1 = acaddoc.SelectionSets.Add("sle1")
    End If
    
    acaddoc.Utility.Prompt "选择需要修剪的对象" & Chr(13)
    
    sle1.SelectOnScreen
    
    'Pnt2 = acaddoc.Utility.GetPoint(, "选择修剪方向")
    Dim det2 As String
    
    Dim IntPnt As Variant
    Dim IntPnt1(2) As Double
    Dim n As Integer
    For Each entObj2 In sle1
    IntPnt = entObj2.IntersectWith(entObjOff, acExtendNone)
    
    If IsArray(IntPnt) Then
        For n = 0 To UBound(IntPnt) Step 3
            IntPnt1(0) = IntPnt(n + 0)
            IntPnt1(1) = IntPnt(n + 1)
            IntPnt1(2) = IntPnt(n + 2)
            det2 = GetDoubleEntTable(entObj2, IntPnt1)
            acaddoc.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr
        Next
    End If
    Next
    
    entObjOff.Delete
   
    Dim command_str As String
    command_str = Chr(3) & Chr(3)
    acaddoc.SendCommand command_str
    acaddoc.Utility.Prompt "修剪完成!"
    acaddoc.SendCommand command_str
    
    'Set acadapp = Nothing
    End
    
End Sub
'转换双元表的函数
Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String
    Dim entHandle As String
    entHandle = entObj.Handle
    GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _
                     ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
End Function
'转换点的函数
Public Function axPoint2lspPoint(Pnt As Variant) As String
    axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
End Function
'转换图元函数
Public Function axEnt2lspEnt(entObj As AcadEntity) As String
    Dim entHandle As String
    entHandle = entObj.Handle
    axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
Function connectcad(acadapp As AcadApplication) As AcadApplication '连接AUTOCAD
On Error Resume Next
     
    '与autocad通信
     
    Set acadapp = GetObject(, "AutoCAD.Application")
    If Err Then
        Err.Clear
        Set acadapp = CreateObject("AutoCAD.Application")
        If Err Then
            MsgBox Err.Description
            Exit Function
        End If
    End If
Set connectcad = acadapp
End Function
'Private Sub Form_Initialize()
'Trim
'End Sub

vdcowde2rp2.jpg