批量裁剪后如何复制粘贴到原坐标

Public Function axEnt2lspEnt(entObj As AcadEntity) As String
    Dim entHandle As String
    entHandle = entObj.Handle
    axEnt2lspEnt = "(handent" & Chr(34) & entHandle & Chr(34) & ")"
End Function
Public Function offent(obj As AcadEntity, off As Double, pt() As Double, de As Boolean) As AcadEntity
    Const pi = 3.1415926
    'obj??????????off???????????????pt()???????????????????,de ???????????????
    '???obj????????????????????????????????????
    Dim obj1 As AcadPolyline
    Dim pl As AcadPolyline
    Dim cr As AcadCircle
    Select Case UCase(obj.ObjectName)
        Case "ACDB3DPOLYLINE", "ACDB2DPOLYLINE"
            ReDim pt(UBound(obj.Coordinates)) As Double
            For I = 0 To UBound(pt) Step 3
                pt(I) = obj.Coordinate(I / 3)(0)
                pt(I + 1) = obj.Coordinate(I / 3)(1)
            Next I
            teml = obj.Layer
            temc = obj.Closed
        Case "ACDBPOLYLINE"
            ReDim pt(((UBound(obj.Coordinates) + 1) / 2) * 3 - 1) As Double
            For I = 0 To UBound(pt) Step 3
                pt(I) = obj.Coordinate((I) / 3)(0)
                pt(I + 1) = obj.Coordinate((I) / 3)(1)
            Next I
            teml = obj.Layer
            temc = obj.Closed
        Case "ACDBCIRCLE"
            Set cr = obj
            Dim pp As Double
            pp = cr.radius
            ReDim pt(359 * 3 + 2) As Double
            For I = 0 To 359
                pt(I * 3) = cr.center(0) + Cos(I * pi / 180) * cr.radius
                pt(I * 3 + 1) = cr.center(1) + Sin(I * pi / 180) * cr.radius
                pt(I * 3 + 2) = 0
            Next I
            teml = obj.Layer
            temc = True
    End Select
    Set obj1 = ThisDrawing.ModelSpace.AddPolyline(pt)
    obj1.Layer = teml
    obj1.Closed = temc
    '---------------------------------
    Dim offobj As AcadEntity
    Select Case off
        Case Is > 0
            off1 = obj1.Offset(off)
            If off1(0).Area  obj1.Area Then
                off1(0).Delete
                off1 = obj1.Offset(-1 * off)
            End If
            Set offobj = off1(0)
    End Select
    '--------------------------------
    Set offent = offobj
    ReDim pt(UBound(offobj.Coordinates)) As Double
    For I = 0 To UBound(pt) Step 3
        pt(I) = offobj.Coordinate(I / 3)(0)
        pt(I + 1) = offobj.Coordinate(I / 3)(1)
    Next I
    obj1.Delete
    Set obj1 = Nothing
    If de Then
        offobj.Delete
    End If
End Function
Public Function chkclose(SSet As AcadSelectionSet) As Boolean
    chkclose = True
    Dim pl As AcadObject
    For I = 0 To SSet.Count - 1
        Set pl = SSet.Item(I)
        Select Case UCase(pl.ObjectName)
            Case "ACDB3DPOLYLINE", "ACDB2DPOLYLINE"
                last = (UBound(pl.Coordinates) + 1) / 3 - 1
            Case "ACDBPOLYLINE"
                last = (UBound(pl.Coordinates) + 1) / 2 - 1
            Case "ACDBCIRCLE"
                last = -1
        End Select
        If last > 0 Then
            If Not (pl.Closed Or (pl.Coordinate(0)(0) = pl.Coordinate(last)(0) And pl.Coordinate(0)(1) = pl.Coordinate(last)(1))) Then
                chkclose = False
                pl.color = acRed
                pl.Highlight True
            End If
        End If
    Next I
End Function
Sub trim()
    Dim ptt(0 To 7) As Double
    pt1 = ThisDrawing.Utility.GetPoint(, " ?????????????:")
    pt2 = ThisDrawing.Utility.GetCorner(pt1, " ?????????????:")
    ptt(0) = pt1(0)
    ptt(1) = pt1(1)
    ptt(2) = pt1(0)
    ptt(3) = pt2(1)
    ptt(4) = pt2(0)
    ptt(5) = pt2(1)
    ptt(6) = pt2(0)
    ptt(7) = pt1(1)
    Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(ptt)
 
    plineObj.Closed = True
       Dim SSet1 As AcadSelectionSet
    For Each SSet1 In ThisDrawing.SelectionSets
        If SSet1.Name = "SS2" Then
            ThisDrawing.SelectionSets.Item("SS2").Delete
            Exit For
        End If
    Next
    Set SSet1 = ThisDrawing.SelectionSets.Add("SS2")
    Dim keyWord As String
    
    
    '??????????????
    Dim ft() As Integer
    Dim fd() As Variant
    ReDim ft(0) As Integer
    ReDim fd(0) As Variant
    ft(0) = 0
    fd(0) = "polyline,lwpolyline,circle"
    
        SSet1.Select acSelectionSetLast, pt1, pt2, ft, fd
    
    If SSet1.Count = 0 Then
        MsgBox "δ???????", vbCritical, "??????"
        Exit Sub
    End If
    If Not chkclose(SSet1) Then
        MsgBox "?????????в???????Σ?" & vbCr & "???飬?????????г???", vbCritical, "?????"
        
        Exit Sub
    End If
    
    ThisDrawing.StartUndoMark
    Dim offobj As AcadEntity
    
    
    Dim off As Double
    off = 0.1
    Dim pt() As Double
    ThisDrawing.Regen acActiveViewport
    'ThisDrawing.Application.ZoomExtents
    
    Dim strcom As String
 
    ThisDrawing.SetVariable "modemacro", "????????????????????..."
    '??????ж??????????????????
    ThisDrawing.SendCommand "trim "
    For I = 0 To SSet1.Count - 1
        ThisDrawing.SendCommand axEnt2lspEnt(SSet1.Item(I)) & vbCr
        Set offobj = offent(SSet1.Item(I), off, pt(), False)
        ThisDrawing.SendCommand axEnt2lspEnt(offobj) & vbCr
    Next I
    ThisDrawing.SendCommand vbCr
    '????????????????????????
    For I = 0 To SSet1.Count - 1
        Set offobj = offent(SSet1.Item(I), off / 2, pt(), True)
        For j = 0 To UBound(pt) Step 3
            strcom = strcom & pt(j)
            strcom = strcom & "," & pt(j + 1) & vbCr
        Next j
        strcom = strcom & pt(0)
        strcom = strcom & "," & pt(1) & vbCr
        strcom = strcom & Chr(9)
    Next I
   
    '???????????????????
    Dim sc() As String
    sc = Split(strcom, Chr(9))
    '------------------------------------------------
    
   
        ThisDrawing.SetVariable "modemacro", "."
        ThisDrawing.SetVariable "modemacro", "??????е?" & j & "?β???..."
        For I = 0 To UBound(sc) - 1
            DoEvents
            ThisDrawing.SendCommand "f " & sc(I) & vbCr
        Next I
'    GoTo begindel
    SSet1.Clear
    ReDim ft(0) As Integer
    ReDim fd(0) As Variant
    ft(0) = 0: fd(0) = "polyline,lwpolyline,circle"
    For I = 0 To UBound(sc) - 1
        pp = Split(sc(I), vbCr)
        n = -1
        For k = 0 To UBound(pp) - 1
            temp = Split(pp(k), ",")
            n = n + 3
            ReDim Preserve pt(n) As Double
            pt(n - 2) = temp(0)
            pt(n - 1) = temp(1)
        Next k
        Set temp = Nothing
        SSet1.SelectByPolygon acSelectionSetFence, pt, ft, fd
        last = SSet1.Count
        Dim lp As Integer
        n = 0
        'lp = 0
        While SSet1.Count  0
            lp = lp + 1
            ThisDrawing.SetVariable "modemacro", "."
            ThisDrawing.SetVariable "modemacro", "??????е?" & lp & "?β???..."
            last = SSet1.Count
            ThisDrawing.SendCommand "f " & sc(I) & vbCr
            SSet1.Clear
            If last = 0 Then GoTo nnext
            SSet1.SelectByPolygon acSelectionSetFence, pt, ft, fd
            If last = SSet1.Count Then
                n = n + 1
            End If
            If n = 4 Then
                GoTo nnext
            End If
        Wend
nnext:
    Next I
    
begindel:
    Set offobj = Nothing
    ReDim pt(0) As Double
    strcom = ""
    Set pp = Nothing
    SSet1.Clear
    ThisDrawing.SendCommand vbCr
   
    ThisDrawing.Utility.InitializeUserInput 0, "1 2"
    
    keyWord = ThisDrawing.Utility.GetKeyword(vbCrLf & "?ü??????????1,?ü????????2 (1/2): ")
    
    If keyWord = "" Then keyWord = "1"
    
    '??????????
    ThisDrawing.SendCommand "e "
 
    '        '??????
    If keyWord = "1" Then
 
        sendcom = "wp "
        For I = 0 To UBound(sc) - 1
            ThisDrawing.SendCommand sendcom & sc(I) & vbCr
        Next I
        
        '???????
    ElseIf keyWord = "2" Then
        sendcom = "r wp "
 
        ThisDrawing.SendCommand "all "
        For I = 0 To UBound(sc) - 1
            ThisDrawing.SendCommand sendcom & sc(I) & vbCr
        Next I
    End If
    
    ThisDrawing.SendCommand vbCr
    ThisDrawing.EndUndoMark
  
End Sub