Topic: Clip Boundaries for a Raster

[ML]

I agree with that CM

Shouldn't looping through objects be quicker then looping through entities?

I am not so sure that entities and objects are looked at the same.

Myself and Keith B had this discussion once and he actually taught me to use object as opposed to entity when interating for a specific object "type"

You know me by now
"The less code the better"

When it comes to programming, if I can turn 5 lines into 3, I will do it.

Mark

[ML]

Yes sir! CM, you are the man!
And so is Bob of course

Well, yet here is one more method.

If Raster already exists in drawing (Paperspace in my scenario) then prompt for clipboundary points.

Code: [Select]

Sub MkRastCBnd()

Dim RastImg As AcadRasterImage
Dim Obj As AcadObject
Dim Objname As String
   
   
For Each Obj In ThisDrawing.PaperSpace
 If Obj.ObjectName = "AcDbRasterImage" Then
  Set RastImg = Obj
  Objname = RastImg.Name
 End If
Next Obj
 
 
 Dim ImgLmts(2) As Double
 ImgLmts(0) = RastImg.Origin(0) + RastImg.ImageWidth
 ImgLmts(1) = RastImg.Origin(1) + RastImg.ImageHeight
 ImgLmts(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
 
'Prompt for pick points on raster and check if the user picks within the raster boundaries
 Dim PntLmts As Boolean
       
 PntLmts = False
 
 Do While PntLmts = 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) <= ImgLmts(0) Then
    If llpnt(1) >= RastImg.Origin(1) And llpnt(1) <= ImgLmts(1) Then
     If urpnt(0) >= RastImg.Origin(0) And urpnt(0) <= ImgLmts(0) Then
      If urpnt(1) >= RastImg.Origin(1) And urpnt(1) <= ImgLmts(1) Then
       PntLmts = True
      Else
       MsgBox "The pick points must be on the raster image " & vbCrLf & _
       "Please try again"
       PntLmts = False
      End If
     Else
      MsgBox "The pick points must be on the raster image " & vbCrLf & _
      "Please try again"
      PntLmts = False
     End If
    Else
     MsgBox "The pick points must be on the raster image " & vbCrLf & _
     "Please try again"
     PntLmts = False
    End If
   Else
    MsgBox "The pick points must be on the raster image " & vbCrLf & _
    "Please try again"
    PntLmts = 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
   'Do whatever
  End With
 
 '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 the image
  RastImg.ClipBoundary ClipPoints
     
 'Enable the display of the clip
  RastImg.ClippingEnabled = True
     
 'Delete Selection Set
  ThisDrawing.SelectionSets.Item("Image").Delete
     
 'Return picked points
  Debug.Print "The lower left picked points = " & llpnt(0) & ", " & llpnt(1)
  Debug.Print "The upper right picked points = " & urpnt(0) & ", " & urpnt(1)
     
Errorhandler:
 If Err.Description = "File access error" Then
  If MsgBox("Can not find image file") Then
   Exit Sub
  End If
 End If
 

End Sub


[ML]

And make the boundary of course!     

[ML]

I forgot:

We should also add Bob's other nice piece of code into this module

Code: [Select]

'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)


[David Hall]

Always use enough lines of code to make it the most efficient.  If that means an extra 10 to save 90% of the clock cycles, thats lines worth typing

[ML]

CM

Did you try the code for if the raster exists?

Mark

[ML]

So, that is cool; now we can insert and create the boundary or create the boundary after it is inserted.

I wonder if you or Bob caught my previous posts on points?

If you go back about 5 or 6, you should see them.

Mark

[ML]

Hey Guys,

I also wanted to toss this in
Just to clarify; my initial intent was to insert the raster at -8 in the X direction so that it was off the title block for the users to pick their points. I originally used the move method for that but I changed it. Instead, I it at -8,0,0
Then you can fill in the move section when/if you know where the raster will permanently reside

Mark

Code: [Select]

Sub InstRastMkCBnd()

Dim RastImg As AcadRasterImage
Dim Imgpath as String, Imgname as String     
Dim InsertPnt(0 To 2) As Double, Scalefactor As Double, RotAngle As Double


Imgpth = ThisDrawing.Path & "\"  'assumes Image File is in the same directory as your drawing
Imgname = "Filename.ext"

ThisDrawing.ActiveSpace = acPaperSpace

InsertPnt(0) = -8#: 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) = 0: MPointN(1) = 0: MPointN(2) = 0
 MPointP(0) = 0: MPointP(1) = 0: MPointP(2) = 0
 
'Move Raster
 RastImg.Move MPointN, MPointP


[Bob Wahr]

So, that is cool; now we can insert and create the boundary or create the boundary after it is inserted.

I wonder if you or Bob caught my previous posts on points?

If you go back about 5 or 6, you should see them.

Mark

Sorry, which posts on points?

[ML]

Hey Bob
Just go back one page
I was just a little confused about something but it is no big deal.

[ML]

Bob

Also, if I may; I have another question for you.

In the method (see top of this page) where we grab an existing raster, then picks our points

What would we do in the case that there are multiple rasters?

I suppose we could interate through paper (or opt the user for space) and ask the user which one (raster) they want to use and set obj = the user picked raster.

After they clip that one, prompt for the next one, etc. etc.

Mark

Code: [Select]

Sub MkCBnd()

Dim RastImg As AcadRasterImage
Dim Obj As AcadObject
Dim Objname As String
   
ThisDrawing.ActiveSpace = acPaperSpace
   
For Each Obj In ThisDrawing.PaperSpace
 If Obj.ObjectName = "AcDbRasterImage" Then
  Set RastImg = Obj
 End If
Next Obj
 
If RastImg Is Nothing Then
 MsgBox "There are no image files in this drawing"
 Exit Sub
Else
'Lower left points of the raster + the image width and height
 Dim ImgLmts(2) As Double
 ImgLmts(0) = RastImg.Origin(0) + RastImg.ImageWidth
 ImgLmts(1) = RastImg.Origin(1) + RastImg.ImageHeight
 ImgLmts(2) = 0
End If


[Bob Wahr]

I'll have to look into the points thing when I have some time to play in acad.  As to the most recent though, the easiest way would be to do a filtered selection set.  If there's one, continue.  If there's more than one, prompt for a selection.  Another option would be just to let the user pick the clip boundary and iterate through the rasters, running the check for containment on each.

[ML]

What do you think would be the best method for them to select each raster without getting into userforms and all that crazy stuff?
I could return each raster with a msgbox but then there is no method to select one; even an input box, there would have to type in the one they want.

With a combobox (if I want to go there) we could return all rasters and allow them to select one.

What do you think? Is there a way without getting into forms?

Thanks

Mark

[ML]

You would still prefer a filtered selection set over the method I am using, huh?
I do realize that we are looping through all objects but the time it is taking is so miniscal that it really is fine

Mark

[Bob Wahr]

Not my program, I don't have a preference.  If asked for a solution to a problem, I gave you what to me seemed the most logical and straightforward method.  You could do a message box with yes/no buttons for each.  Your users will hate you.  You can do the form you mentioned.  Lots of ways to skin a cat.