« previous next »
Pages: 1 ... 7 8 [9] 10 11 ... 13 |   Go Down

Author Topic: Clip Boundaries for a Raster  (Read 40078 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
Re: Clip Boundaries for a Raster
« Reply #120 on: November 20, 2007, 01:26:42 PM »
Yes, that is true

Sorry

Did you figure out the alternative to Go To?

We could put

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

in place of each Go To but does that make anymore sense?

Maybe?

Not sure

Mark
Logged

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #121 on: November 20, 2007, 01:57:39 PM »
we cant put that in instead of the goto b/c if that second set of picks were also bogus, we would be past the checking of coords, and it wouldn't know it
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

ML

  • Guest
Re: Clip Boundaries for a Raster
« Reply #122 on: November 20, 2007, 02:01:53 PM »

I'm sorry
I have been trying to study your code but I keep getting distracted :)

Let me take a closer look

Mark
Logged

Bob Wahr

  • Guest
Re: Clip Boundaries for a Raster
« Reply #123 on: November 20, 2007, 02:07:06 PM »
OK, I just put all of about 30 seconds thought into this but what about somefin like
[psueudocode]
do until pntsValid
With ThisDrawing.Utility
  llpnt = .GetPoint(, vbCrLf & "Select Lower Left Point: ")
   urpnt = .GetPoint(, vbCrLf & "Select Upper Right Point: ")
End With
      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
                              pntsvalid = true
                        Else
                           ThisDrawing.utility.prompt "At least one of those points was teh suck." & vbcrlf
                        end if
                  end if
            end if
      end if
loop[/psuedocode]
Logged

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #124 on: November 20, 2007, 02:29:35 PM »
I like the idea, let me code that up
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #125 on: November 20, 2007, 03:06:38 PM »
This is what I came up with.  Comments to improve it welcome
Code: [Select]
PickPoints:
      '      With ThisDrawing.Utility
      '            llpnt = .GetPoint(, vbCrLf & "Select Lower Left Point: ")
      '            urpnt = .GetPoint(, vbCrLf & "Select Upper Right Point: ")
      '      End With
      Dim Check As Boolean
      Check = False
      Do While Check = False
            With ThisDrawing.Utility
                  llpnt = .GetPoint(, vbCrLf & "Select Lower Left Point: ")
                  urpnt = .GetPoint(, vbCrLf & "Select Upper Right Point: ")
            End With
            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
                                    Check = True
                              Else
                                    MsgBox "Please repick inside Raster IMage"
                                    Check = False
                              End If
                        Else
                              MsgBox "Please repick inside Raster IMage"
                              Check = False
                        End If
                  Else
                        MsgBox "Please repick inside Raster IMage"
                        Check = False
                  End If
            Else
                  MsgBox "Please repick inside Raster IMage"
                  Check = False
            End If
      Loop
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #126 on: November 20, 2007, 03:07:40 PM »
I left the PickPoints: and the old pick points there while testing.  Those can be removed from final code
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

ML

  • Guest
Re: Clip Boundaries for a Raster
« Reply #127 on: November 20, 2007, 03:28:17 PM »

CM

It is prompting me twice for my points with The Boolean Method

Mark
Logged

ML

  • Guest
Re: Clip Boundaries for a Raster
« Reply #128 on: November 20, 2007, 04:00:35 PM »

CM,

Check this out
I modified your code slightly
Hope you don't mind
It makes a lot more sense to me now
Mark

Code: [Select]
If llpnt(0) > RastImg.Origin(0) And llpnt(0) < RastImg.ImageWidth Then
      If llpnt(1) > RastImg.Origin(1) And llpnt(1) < RastImg.ImageHeight Then
       If urpnt(0) > RastImg.Origin(0) And urpnt(0) < RastImg.ImageWidth Then
        If urpnt(1) > RastImg.Origin(1) And urpnt(1) < RastImg.ImageHeight 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
Logged

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #129 on: November 20, 2007, 04:44:22 PM »
This gets rid of the goto s
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
      Imgpth = "c:\"
      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
      Dim Check As Boolean
      Check = False
      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
                                    Check = True
                              Else
                                    MsgBox "Please repick inside Raster IMage"
                                    Check = False
                              End If
                        Else
                              MsgBox "Please repick inside Raster IMage"
                              Check = False
                        End If
                  Else
                        MsgBox "Please repick inside Raster IMage"
                        Check = False
                  End If
            Else
                  MsgBox "Please repick inside Raster IMage"
                  Check = 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
      '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
« Last Edit: November 20, 2007, 05:07:08 PM by CmdrDuh »
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #130 on: November 20, 2007, 04:46:49 PM »
Twice?  very interesting.  I just tested and I can do 1 set of picks if I play by the rules.  Of course if I pick anywhere outside the boundary, it will prompt me til I make 2 good picks inside the boundary
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #131 on: November 20, 2007, 04:57:59 PM »
Code: [Select]
If llpnt(0) > RastImg.Origin(0) And llpnt(0) < RastImg.ImageWidth Then
      If llpnt(1) > RastImg.Origin(1) And llpnt(1) < RastImg.ImageHeight Then
llpnt(1) < RastImg.ImageHeight is only comparing the Y of LLpnt against the height of the image.  Assume image was 10x10 and origin was 60,60,0?
your LL of image is 60,60,0 and UR of image is 70,70,0 right? now if you test a point picked at 65,65,0, your test llpnt(1) < RastImg.ImageHeight
 will fail b/c 65 is not < 10
« Last Edit: November 20, 2007, 04:59:28 PM by CmdrDuh »
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #132 on: November 20, 2007, 05:01:05 PM »
Basically, if your image is ALWAYS inserted at 0,0,0 the code will work b/c image.width and the X value of image.width are equal.  If your image is ever moved from 0,0,0 then you will need to add Image.width + Image.Origin(X)
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #133 on: November 20, 2007, 05:04:49 PM »
If you copy the code from 4 posts up, and change the hard coded paths only, does it work or crash?  If it crashes, can you F8 thru it and tell me where it crashes.
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4076
Re: Clip Boundaries for a Raster
« Reply #134 on: November 20, 2007, 05:10:37 PM »
I also made a few more changes highlighted below
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
      Imgpth = "c:\"
      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
      Dim Check As Boolean
      Check = False
      Do While Check = False
[color=red]            llpnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Select Lower Left Point: ")
            urpnt = ThisDrawing.Utility.GetCorner(llpnt, vbCrLf & "Select Upper Right Point: ")[/color]
            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
                                    Check = True
                              Else
                                    MsgBox "Please repick inside Raster IMage"
                                    Check = False
                              End If
                        Else
                              MsgBox "Please repick inside Raster IMage"
                              Check = False
                        End If
                  Else
                        MsgBox "Please repick inside Raster IMage"
                        Check = False
                  End If
            Else
                  MsgBox "Please repick inside Raster IMage"
                  Check = 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
      '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
Logged
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)
Pages: 1 ... 7 8 [9] 10 11 ... 13 |   Go Up
« previous next »