Topic: Clip Boundaries for a Raster

[ML]

You're a trooper my friend

We'll do

[Bob Wahr]

Just for the sake of completion, maybe the image and the dwg.  Oh, and the most upest to date code

[ML]

Hey guys,

I am posting the lastest code, but in all due respect; wouldn't the same errors occur on your machines once you have the latest code?

If you really want to simulate what I am doing, all you need to do is draw a 5' X 5' rectangle in paperspace; then point the path (imgpath) in the code to a known raster on your machine and we should all then be on the same page.

Actually, I just changed the variable imgpath = ThisDrawing.Path & "\"
So now you can just place any raster in the same directory as your .dwg file and it should be found.
Variable imgname needs to equal your file name

Also, I think the best example to use is the first one under Dynamic; it is the only one "not" commented out

Thanks,

Mark

Code: [Select]

Public Sub InstRast()
 
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 = Imgname
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 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

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

 
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]

Hey guys,
I am posting the lastest code, but in all due respect; wouldn't the same errors occur on your machines once you have the latest code?

Yes, but its much easier to trouble shoot when we can "SEE" the error instead of relying on you to explain it. (NoOffense but a pic is worth....)

[David Hall]

ok, so far I ahve made 2 changes. 1-I hardpathed my imgpath var to c:\ where I put image, No big deal.  2-I am dropping line 1 of

RastImg.Name = Imgname
RastImg.Name = Left(Imgname, Len(Imgname) - 4)

to just have the second line as the first is not helpful

[ML]

I understand CM but there is no error being generated.
If you pick off the raster, the imageframe will still appear but no image will be visible "unless" you drag the imageframe manually.

Do me a favor CM; try to pick 2 points on your raster; make sure one point is off the raster and please tell me if the same thing happens to you?

It could possibly be a setting that I am not aware of

Thank you,
Mark

[ML]

Good catch

I probably only need the second one correct?

I def. need the second one as I am trimming off the .tif extension

Mark

[David Hall]

OK, so if the image is inserted at a scale of 1 the corner to corner dist is
Delta X = 7.6500,  Delta Y = 11.6033

Why are we inserting it at -8,0,0?

Scaled up 12 times yields
Delta X = 91.8000,  Delta Y = 139.2400 for distances

So is this image in Feet or Inches?  Looks like it should be feet, but we scaled it up so Im not sure now

[ML]

This also goes back to our early discussion as to why ACAD gives rasters a unique/weird name on insert using VBA

When you manually insert a raster, it will adopt the default file name but you can then change the raster name after it is inserted.

Same with xrefs

This is why we "need" to say
RastImg.Name = Imgname
or
RastImg.Name = Left(Imgname, Len(Imgname) - 4)

Mark

[David Hall]

The image is clipped on what ever points we pick, even if off the page.  what you need to do is check the 2 points and make sure they are B/T ins and UR of image

[David Hall]

This also goes back to our early discussion as to why ACAD gives rasters a unique/weird name on insert using VBA

When you manually insert a raster, it will adopt the default file name but you can then change the raster name after it is inserted.

Same with xrefs

This is why we "need" to say
RastImg.Name = Imgname
or
RastImg.Name = Left(Imgname, Len(Imgname) - 4)

Mark

yes, but not both.  Just the second is needed

[David Hall]

Do a IF LLpnt(0) > ImageIns AND LLpnt(0)< UR(0) then
If LL(1)>ImgIns(1) and LL(1)<UR(1) then
proceed to second point

[ML]

I moved it over 8' to get it off of 0,0 and to the side of the title block.
After the user does their thing, they can move it to the nec. (5' x 5' square) spot on the tblock.
Once we are certain where this rectangle will permanently reside, then I will make the adjustments.

As far as the scale; it is what my boss asked me to do, so I did it.

I believe it is to bring the image up to feet.

We do work in feet as we are a Civil Firm

Mark

[David Hall]

That will help you guarentee the picked points are "on" the raster, not off the pic

[David Hall]

Just out of curiousity, what are the dims of x and y on your image before its clipped?  is it close to the numbers I posted above?  I just measured the dist between 2 streets, and its like 2 units, so are we dealing with a scaled up scaled raster?