Topic: Clip Boundaries for a Raster

[David Hall]

I got rid of the extra 2 lines from the With, and changed to GetCorner so the user can "see" where they are picking

[ML]

CM,

I just copied the whole thing down from your post
All seems to be working really well now

Very nice job!

Mark

[ML]

I'm sorry?

What 2 withs?

Mark

[David Hall]

Code: [Select]

[color=red]With ThisDrawing.Utility[/color]
  llpnt = .GetPoint(, vbCrLf & "Select Lower Left Point: ")
   urpnt = .GetPoint(, vbCrLf & "Select Upper Right Point: ")
[color=red]End With[/color]became

Code: [Select]

            llpnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Select Lower Left Point: ")
            urpnt = ThisDrawing.Utility.[color=red]GetCorner(llpnt[/color], vbCrLf & "Select Upper Right Point: ")

[David Hall]

I just eliminated 2 lines of code, the first was the start of the With statement, the second was the EndWith

[ML]

Very good idea!

That works really well!

CM, have you notice that if you pick on the upper right endpoint that you get an error?

The endpoint should be considered part of the image

Mark

[Bob Wahr]

That's because it testing for </> not =</=>

[ML]

CM

Please correct me if I am wrong:

Can't we get away with this?

Code: [Select]

Do While Check = False
      llpnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Select Lower Left Point: ")
      urpnt = ThisDrawing.Utility.GetCorner(llpnt, vbCrLf & "Select Upper Right Point: ")
     
       If llpnt(0) > RastImg.Origin(0) And llpnt(0) < ImgUR(0) Then
        If llpnt(1) > RastImg.Origin(1) And llpnt(1) < ImgUR(1) Then
         If urpnt(0) > RastImg.Origin(0) And urpnt(0) < ImgUR(0) Then
          If urpnt(1) > RastImg.Origin(1) And urpnt(1) < ImgUR(1) Then
           Pnts = True
          Else
           MsgBox "Pick points inside the raster image"
           Check = False
         End If
        End If
       End If
      End If
 Loop

I would think we only need these lines of code

Code: [Select]

Else
 MsgBox "Pick points inside the raster image"
 Pnts = False

Once ?

Mark

[ML]

Sorry I meant check = False

[ML]

Bob

So you are saying 
If I put the = sign in, then that will take care of the endpoint problem?

Mark

[Bob Wahr]

I would think we only need these lines of code

Code: [Select]

Else
 MsgBox "Pick points inside the raster image"
 Pnts = False

Once ?

Mark

Nope.  If you only have it once, it will only work if it fails in that place.  You need to account for failure on each of you IF statements.

Bob

So you are saying 
If I put the = sign in, then that will take care of the endpoint problem?

Mark

More like

Code: [Select]

       If llpnt(0) > RastImg.Origin(0) And llpnt(0) < ImgUR(0) ElseIf llpnt(0) = RastImg.Origin(0) And llpnt(0) = ImgUR(0) Then

[ML]

Yes Bob you were correct, great catch!

CM,

You need the = sign in your operations in case the user picks on an endpoint in which case the condition would be <> or = to the far (end) points else (as is) you get an error if they pick an endpoint.

Code: [Select]

If llpnt(0) >= RastImg.Origin(0) And llpnt(0) <= ImgUR(0) Then
 If llpnt(1) >= RastImg.Origin(1) And llpnt(1) <= ImgUR(1) Then
  If urpnt(0) >= RastImg.Origin(0) And urpnt(0) <= ImgUR(0) Then
   If urpnt(1) >= RastImg.Origin(1) And urpnt(1) <= ImgUR(1) Then

Also, I did see why we need the message 3 times in case either one of those conditions are not met.

Mark

[ML]

Bob

You beat me to the draw but I think the method I posted works fine too

Please correct me if I am wrong

Thank you

Mark

[ML]

One last note guys; then my brain is effectively done for the day.

If you place the selection set code

Code: [Select]

'Create Selection Set for Raster
  Dim Sset As AcadSelectionSet
     
  Set Sset = ThisDrawing.SelectionSets.Add("Image")
  Sset.Select acSelectionSetLast
     
  Debug.Print "Selection Set " & "("; Sset.Name; ")" & " was created"
     
  With Sset
   'Do whatever you'd like here
  End With

Right after CM's loop but "before" the clip boundaries are created, it makes the undo feature in ACAD very effective.

Still, delete the selection set

Code: [Select]

ThisDrawing.SelectionSets.Item("Image").Delete

Right before the Error handler code, unless of course you need it for some reason.

Even though the selection set is deleted, it is still looked at as the last selected item in ACAD and if the user wanted to undo the clip, just do an undo.

Pretty cool

Mark

[ML]

I thought it might help to post the code as it stands right now so that we can all be on the same page

CM, I changed a few minor things, just the formatting to the way I use to having it and may be a variable name but all of your methods are exactly the same. I added the = sign in your conditions also.
Please take note of where I placed the selection set code also
Mark

Code: [Select]

Public Sub InstRast()

     Dim RastImg As AcadRasterImage
     Dim Imgpth As String
     Dim Imgname As String
     
     Dim InsertPnt(0 To 2) As Double, scalefactor As Double, RotAngle As Double
     
     ThisDrawing.ActiveSpace = acPaperSpace
     
     Imgpth = ThisDrawing.Path & "\"
     Imgname = "FtWashington600.tif"
     
     InsertPnt(0) = 0#: InsertPnt(1) = 0#: InsertPnt(2) = 0#
     scalefactor = 1
     RotAngle = 0
     
     On Error GoTo Errorhandler
     Set RastImg = ThisDrawing.PaperSpace.AddRaster(Imgpth & Imgname, InsertPnt, scalefactor, RotAngle)
     
     RastImg.Name = Left(Imgname, Len(Imgname) - 4)
     RastImg.scalefactor = 12
     
    'Move Points
     Dim MPointN(0 To 2) As Double 'Negative
     Dim MPointP(0 To 2) As Double 'Positive
     MPointN(0) = 8: MPointN(1) = 0: MPointN(2) = 0
     MPointP(0) = 0: MPointP(1) = 0: MPointP(2) = 0
     
    'Move Raster
     RastImg.Move MPointN, MPointP
     
     Dim ImgUR(2) As Double
     
     ImgUR(0) = RastImg.Origin(0) + RastImg.ImageWidth
     ImgUR(1) = RastImg.Origin(1) + RastImg.ImageHeight
     ImgUR(2) = 0
     
     Dim llpnt As Variant 'lower left point
     Dim urpnt As Variant 'upper right point
     Dim mdpnt(0 To 2) As Double
     Dim ClipPoints(0 To 9) As Double
     
    'Getpoints on raster and check if the user picks within the raster boundaries
     Dim Pnts As Boolean
               
     Pnts = False
     
     Do While Pnts = False
      llpnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Select Lower Left Point: ")
      urpnt = ThisDrawing.Utility.GetCorner(llpnt, vbCrLf & "Select Upper Right Point: ")
     
       If llpnt(0) >= RastImg.Origin(0) And llpnt(0) <= ImgUR(0) Then
        If llpnt(1) >= RastImg.Origin(1) And llpnt(1) <= ImgUR(1) Then
         If urpnt(0) >= RastImg.Origin(0) And urpnt(0) <= ImgUR(0) Then
          If urpnt(1) >= RastImg.Origin(1) And urpnt(1) <= ImgUR(1) Then
           Pnts = True
          Else
           MsgBox "Pick points inside the raster image"
           Pnts = False
          End If
         Else
          MsgBox "Pick points inside the raster image"
          Pnts = False
         End If
        Else
         MsgBox "Pick points inside the raster image"
         Pnts = False
        End If
       Else
        MsgBox "Pick points inside the raster image"
        Pnts = False
       End If
      Loop
     
      mdpnt(0) = (llpnt(0) + urpnt(0)) / 2 'Midpoint (X) = (The far left picked point + the far right picked point) / 2
      mdpnt(1) = (llpnt(1) + urpnt(1)) / 2 'Midpoint (Y) = (The far bottom picked point + the far top picked point) / 2
      mdpnt(2) = 0
     
     'Create Selection Set for Raster
      Dim Sset As AcadSelectionSet
     
      Set Sset = ThisDrawing.SelectionSets.Add("Image")
      Sset.Select acSelectionSetLast
     
      Debug.Print "Selection Set " & "("; Sset.Name; ")" & " was created"
     
      With Sset
      End With
           
         
     'FINITE
     'Create a 5 x 5 clip boundary
      '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

     'Clip boundary = 2.5 from the mdpnt of the raster's picked points to the boundary coords.
      ClipPoints(0) = mdpnt(0) - 2.5: ClipPoints(1) = mdpnt(1) - 2.5
      ClipPoints(2) = mdpnt(0) - 2.5: ClipPoints(3) = mdpnt(1) + 2.5
      ClipPoints(4) = mdpnt(0) + 2.5: ClipPoints(5) = mdpnt(1) + 2.5
      ClipPoints(6) = mdpnt(0) + 2.5: ClipPoints(7) = mdpnt(1) - 2.5
      ClipPoints(8) = mdpnt(0) - 2.5: ClipPoints(9) = mdpnt(1) + -2.5

     'DYNAMIC
     'Clip boundary = picked points (llpnt and urpnt)
'      ClipPoints(0) = llpnt(0): ClipPoints(1) = llpnt(1)
'      ClipPoints(2) = llpnt(0): ClipPoints(3) = urpnt(1)
'      ClipPoints(4) = urpnt(0): ClipPoints(5) = urpnt(1)
'      ClipPoints(6) = urpnt(0): ClipPoints(7) = llpnt(1)
'      ClipPoints(8) = llpnt(0): ClipPoints(9) = llpnt(1)

     'Clip boundary =  user defined (uniform) size
      'Dim Bndsize As Double
      'Bndsize = ThisDrawing.Utility.GetReal("What size boundary would you like?: ")
     
      'ClipPoints(0) = mdpnt(0) - (Bndsize / 2): ClipPoints(1) = mdpnt(1) - (Bndsize / 2)
      'ClipPoints(2) = mdpnt(0) - (Bndsize / 2): ClipPoints(3) = mdpnt(1) + (Bndsize / 2)
      'ClipPoints(4) = mdpnt(0) + (Bndsize / 2): ClipPoints(5) = mdpnt(1) + (Bndsize / 2)
      'ClipPoints(6) = mdpnt(0) + (Bndsize / 2): ClipPoints(7) = mdpnt(1) - (Bndsize / 2)
      'ClipPoints(8) = mdpnt(0) - (Bndsize / 2): ClipPoints(9) = mdpnt(1) + -(Bndsize / 2)

    'Clip the image
      RastImg.ClipBoundary ClipPoints
     
    'Enable the display of the clip
      RastImg.ClippingEnabled = True
     

      ThisDrawing.SelectionSets.Item("Image").Delete
     
     
Errorhandler:
      If Err.Description = "File access error" Then
       If MsgBox("Can not find image file") Then
        Exit Sub
       End If
      End If
End Sub