Topic: Clip Boundaries for a Raster

[David Hall]

The grid measures ~10x13

[ML]

CM

I am not sure where you are going with that method?

I like the idea of grabbing the height and width of the raster on insert, then we can say:

Code: [Select]

If llpnt + urpnt > then The height + width of the inserted raster x The scale
 Then What do you think?
End If

Mark

[ML]

Ok the raster that I e-mailed you is the unscaled version.
Yes we are scaling that raster up by 12

Mark

I am also trying to fugure something out in Excel VBA AHHHHHHHHHHHH


LOL

Mark

[ML]

Oh yes,

You have the exact same distance on the raster that I get

Mark

[David Hall]

So basically, what I see is that we need to make sure LL and UR points are ON the raster, regardless of the size of the clip window, and if not, reprompt for new points.  I'll try to work something up for that tomorrow

[ML]

Yes sir

Actually the user needs to make sure they pick on the raster but yes, you got it.
We need to account for the fact that they did not.

It sounds like you are on the right track exactly.

There is no hurry my friend. It is just an added bonus, nice to have type thing

Mark

[David Hall]

ML, give this a shot, pick everywhere you can think of.  The msgboxs will come out of the finished code, just there for testing purposes.  Also, you will need to edit the image name and path b/c I hardcoded mine

Code: [Select]

Option Explicit
Public Sub InstRast()

      Dim Imgpth As String
      Dim Imgname As String
      Dim InsertPnt(0 To 2) As Double, scalefactor As Double, RotAngle As Double
      Dim RastImg As AcadRasterImage
      ThisDrawing.ActiveSpace = acPaperSpace

[color=red]      Imgpth = "c:\"
      Imgname = "FtWashington600.tif"[/color]

      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 = Imgname
      RastImg.Name = Left(Imgname, Len(Imgname) - 4)

      'RastImg.scalefactor = 1
      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



      [color=red]Dim ImgUR(2) As Double
      ImgUR(0) = RastImg.Origin(0) + RastImg.ImageWidth: ImgUR(1) = RastImg.Origin(1) + RastImg.ImageHeight: ImgUR(2) = 0[/color]


      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






PickPoints:
      With ThisDrawing.Utility
            llpnt = .GetPoint(, vbCrLf & "Select Lower Left Point: ")
            urpnt = .GetPoint(, vbCrLf & "Select Upper Right Point: ")
      End With


    [color=red]  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
                              MsgBox "Good picks"
                        Else
                              MsgBox "Please repick inside Raster IMage"
                              GoTo PickPoints
                        End If
                  Else
                        MsgBox "Please repick inside Raster IMage"
                        GoTo PickPoints
                  End If
            Else
                  MsgBox "Please repick inside Raster IMage"
                  GoTo PickPoints
            End If
      Else
            MsgBox "Please repick inside Raster IMage"
            GoTo PickPoints
      End If
[/color]





      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



      '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


      '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

      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


[David Hall]

Also you will need to remove the COLOR code from above to make it work.  I highlighted (DUH) the parts I changed

[David Hall]

This brings up a good question for you guys, how to NOT use the GoTo as I know its the bain of good programming.  I have seen a way to not use it, but I just cant remember where it was.  Maybe 808 remembers, cuz I think he gave it to me

[Bob Wahr]

This brings up a good question for you guys, how to NOT use the GoTo as I know its the bain of good programming.  I have seen a way to not use it, but I just cant remember where it was.  Maybe 808 remembers, cuz I think he gave it to me

I vaguely remember what you're talking about but not in detail.  I'll try to remember.  Pretty crazy busy this week though.

[ML]

I'm not so sure, even though I would never claim to be a great programmer (or even formally trained) by any stretch however I have been using Go to for a longtime and it has always been a reliable source for me.

I did notice that you are using it 4 times, in which case I may consider having a separate Sub for The Go to which is only the Pickpoints in this case; so, do we, don't we?

Is calling a sub 4 possible times any better or different then using Go to 4 times ?

I just tried your code CM,  it seems to be working real well; I do need to put it through some more tests.

That is cool that there is a Raster.origin method
So far it looks good

Mark

[ML]

CM

The color coding did not effect the code at all; nor should it.
When copying and pasting, we are only grabbing the text, not the text formatting.
Therefore what you did is fine

Mark

[ML]

I have an easy answer to The Goto question;
It is called Google

Let me see what I can find

Mark

[ML]

CM

Good Job Man! It looks like it is working really well.
I might clean it up a bit and do a few things but you did a nice job.

It is definitely working as i hoped, thank you!

Oh, here is some bonus code if you want it?
I like to see these little things, it helps me to know what is going on.

Code: [Select]

'These coords are prior to picking your points
 Debug.Print "Raster Origin X = " & RastImg.Origin(0)
 Debug.Print "Raster Origin Y = " & RastImg.Origin(1)
 Debug.Print "Raster Width = " & RastImg.ImageWidth
 Debug.Print "Raster Height = " & RastImg.ImageHeight

I placed it under your

Code: [Select]

Dim ImgUR(2) As Double
ImgUR(0) = RastImg.Origin(0) + RastImg.ImageWidth: ImgUR(1) = RastImg.Origin(1) + RastImg.ImageHeight: ImgUR(2) = 0

code

Mark

[David Hall]

I did notice that you are using it 4 times, in which case I may consider having a separate Sub for The Go to which is only the Pickpoints in this case; so, do we, don't we?  Is calling a sub 4 possible times any better or different then using Go to 4 times ?

we are not calling it 4 times, only once IF one of the X or Y values falls outside the image boundary