栅格的裁剪边界

Sub InstRast()
    Dim InsertPnt(0 To 2) As Double
    Dim scalefactor As Double
    Dim RotAngle As Double
    Dim Imgpth As String
    Dim Imgname As String
    Dim RastImg As AcadRasterImage
    
    Imgpth = "K:\AutoCAD\Work Related"
    Imgname = "FtWashington600.tif"
   
    InsertPnt(0) = 0#: InsertPnt(1) = 0#: InsertPnt(2) = 0#
    scalefactor = 12#
    rotationAngle = 0
    
    On Error Resume Next
    
    Set RastImg = ThisDrawing.PaperSpace.AddRaster(Imgpth & Imgname, InsertPnt, scalefactor, RotAngle)
    
    RastImg.Name = Imgname
    RastImg.Name = Left(Imgname, Len(Imgname) - 4)
    
    If Err.Description = "Filer error" Then
        MsgBox ImageName & " could not be found."
        Exit Sub
    End If
    
    ZoomAll
        
    ' Establish the clip boundary with an array of points
    Dim clipPoints(0 To 9) As Double
    clipPoints(0) = 6: clipPoints(1) = 6.75
    clipPoints(2) = 7: clipPoints(3) = 6
    clipPoints(4) = 6: clipPoints(5) = 5
    clipPoints(6) = 5: clipPoints(7) = 6
    clipPoints(8) = 6: clipPoints(9) = 6.75
    
    ' Clip the image
    RastImg.ClipBoundary clipPoints
    
    ' Enable the display of the clip
    RastImg.ClippingEnabled = True
    ThisDrawing.Regen acActiveViewport
       
End Sub

Sub InstRast()
    Dim InsertPnt(0 To 2) As Double
    Dim scalefactor As Double
    Dim RotAngle As Double
    Dim Imgpth As String
    Dim Imgname As String
    Dim RastImg As AcadRasterImage
    
    Imgpth = "K:\AutoCAD\Work Related"
    Imgname = "FtWashington600.tif"
   
    InsertPnt(0) = 0#: InsertPnt(1) = 0#: InsertPnt(2) = 0#
    scalefactor = 12#
    rotationAngle = 0
    
    On Error Resume Next
    
    Set RastImg = ThisDrawing.PaperSpace.AddRaster(Imgpth & Imgname, InsertPnt, scalefactor, RotAngle)
    
    RastImg.Name = Imgname
    RastImg.Name = Left(Imgname, Len(Imgname) - 4)
    
    If Err.Description = "Filer error" Then
        MsgBox ImageName & " could not be found."
        Exit Sub
    End If
    
    ZoomAll
        
    ' Establish the clip boundary with an array of points
    Dim clipPoints(0 To 9) As Double
    clipPoints(0) = 0: clipPoints(1) = 0
    clipPoints(2) = 0: clipPoints(3) = 60
    clipPoints(4) = 60: clipPoints(5) = 60
    clipPoints(6) = 60: clipPoints(7) = 0
    clipPoints(8) = 0: clipPoints(9) = 0
    
    ' Clip the image
    RastImg.ClipBoundary clipPoints
    
    ' Enable the display of the clip
    RastImg.ClippingEnabled = True
    ThisDrawing.Regen acActiveViewport
       
End Sub

Dim clipPoints(0 To 9) As Double
    clipPoints(0) = 0: clipPoints(1) = 0
    clipPoints(2) = 0: clipPoints(3) = 5
    clipPoints(4) = 5: clipPoints(5) = 5
    clipPoints(6) = 5: clipPoints(7) = 0
    clipPoints(8) = 0: clipPoints(9) = 0

Sub Example_ClippingEnabled()
    ' This example adds a raster image in model space.
    ' It then clips the image based on a clip boundary,
    ' and toggles the display of the clipping.
    
    Dim insertionPoint(0 To 2) As Double
    Dim scalefactor As Double
    Dim rotationAngle As Double
    Dim imageName As String
    Dim rasterObj As AcadRasterImage
    
    imageName = "C:\AutoCAD\sample\downtown.jpg"
    insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0#
    scalefactor = 2#
    rotationAngle = 0
    
    On Error Resume Next
    ' Creates a raster image in model space
    Set rasterObj = ThisDrawing.ModelSpace.AddRaster(imageName, insertionPoint, scalefactor, rotationAngle)
    
    If Err.Description = "Filer error" Then
        MsgBox imageName & " could not be found."
        Exit Sub
    End If
    
    ZoomAll
    MsgBox "Clip the image?", , "ClipBoundary Example"
    
    ' Establish the clip boundary with an array of points
    Dim clipPoints(0 To 9) As Double
    clipPoints(0) = 6: clipPoints(1) = 6.75
    clipPoints(2) = 7: clipPoints(3) = 6
    clipPoints(4) = 6: clipPoints(5) = 5
    clipPoints(6) = 5: clipPoints(7) = 6
    clipPoints(8) = 6: clipPoints(9) = 6.75
    
    ' Clip the image
    rasterObj.clipBoundary clipPoints
    
    ' Enable the display of the clip
    rasterObj.ClippingEnabled = True
     ThisDrawing.Regen acActiveViewport
   MsgBox "Turn off the display of the clipped image.", , "ClippingEnabled Example"
    
    ' Disable the display of the clip
    rasterObj.ClippingEnabled = False
    ThisDrawing.Regen acActiveViewport
    MsgBox "Display off.", , "ClippingEnabled Example"
    
End Sub

1--------2
5        |
|        |
|        |
4--------3

Dim llpnt As Variant 'lower left point
Dim urpnt As Variant 'upper right point
With ThisDrawing.Utility
 llpnt = .GetPoint(, vbCrLf & "Select Lower Left Point: ")
 urpnt = .GetPoint(, vbCrLf & "Select Upper Right Point: ")
End With