Topic: Clip Boundaries for a Raster

[ML]

OK
I stand corrected by myself 
The selection set is not why the undo feature is working; it works regardless. DALP!
Of course there may be other reasons to keep it in there; it is completely up to your guys

Kirk out

[David Hall]

Wow, you guys stayed late last night.

[ML]

Yes sir

No rest for the weary

[ML]

Hey guys,
I know this is a little bit obsessive but I am just curious;
If I select the lower left (llpnt) and the upper right (urpnt) points of the raster,
I have the results printing to the Immediate Window -->
Take note of the results, which are the correct points

Code: [Select]

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

'From Immediate Window
The lower left picked points = -8, 0
The upper right picked points = -0.3500000000012, 11.6033333333333

However, if I use the code that Bob gave me:

Code: [Select]

Sub Getpoints()

Dim Pnt As Variant
Dim i As Integer

On Error GoTo NoPoint

Do
  Pnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Pnt" & i)
  Debug.Print "Pnt" & i & ": "; Pnt(0) & "," & Pnt(1)
  i = i + 1
Loop

NoPoint:
  If Err.Number Then
   Err.Clear
   Exit Sub
  End If
End Sub
To get my points;
The lower left points (llpnt) are being returned as
-8,-1.34354333214404E-15

Does anybody know why this is happening?

In Bob's code, do we need to have a round function?
In both modules; the same exact method is being used but the results are different?

Mark

[ML]

In this example:

Code: [Select]

Sub Getpoints_xymid()

Dim llpnt As Variant 'lower left point
Dim urpnt As Variant 'upper right point
Dim xpnts As Variant
Dim ypnts As Variant
Dim mdpnt(0 To 2) As Double

With ThisDrawing.Utility
 llpnt = .GetPoint(, vbCrLf & "Select Lower Left Point: ")
 urpnt = .GetCorner(llpnt, 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
xpnts = llpnt(0) + urpnt(0)
ypnts = llpnt(1) + urpnt(1)


Debug.Print "Lower left points: "; llpnt(0) & "," & llpnt(1)
Debug.Print "Upper right points: "; urpnt(0) & "," & urpnt(1)
Debug.Print "Midpoints: "; mdpnt(0) & "," & mdpnt(1) & vbCrLf
Debug.Print "Xpoints (0) + (1) = "; xpnts
Debug.Print "Ypoints (0) + (1) = "; ypnts

End Sub

Check out the results:

Lower left points: -8,-1.34354333214404E-15
Upper right points: -0.3500000000012,11.6033333333333
Midpoints: -4.1750000000006,5.80166666666667

Xpoints (0) + (1) = -8.3500000000012
Ypoints (0) + (1) =  11.6033333333333

The Y Points are being calculated correctly as Xpoint (1) should = 0
Still, look here, look at Lower left points:
It is giving me -1.34354333214404E-15 instead of 0
WTF!

The question is why?

Mark

[ML]

Sorry guys

The code should read like this

Code: [Select]

Debug.Print "Lower left points: "; llpnt(0) & "," & llpnt(1)
Debug.Print "Upper right points: "; urpnt(0) & "," & urpnt(1) & vbCrLf
Debug.Print "Xpoints (0) + (0) = "; xpnts
Debug.Print "Ypoints (1) + (1) = "; ypnts & vbCrLf
Debug.Print "Midpoints: "; mdpnt(0) & "," & mdpnt(1)

The correction is:
Xpoints (0) + (0) = "; xpnts
Ypoints (1) + (1) = "; ypnts

Still the prior post does has the correct numbers, it was just the way I was displaying the string (in the immediate window) that was wrong

Mark

[ML]

Hey guys

Just when you thought it was OVER; I have yet one more idea

OK,

If the raster already exists in the drawing, then we can still utilize this code.
I have most of it written
I just need help with the line in red.

Thanks

Mark

Code: [Select]

Sub InstRast3()

Dim RastImg As AcadRasterImage
Dim Obj As AcadObject
Dim Objname As String
 
 
For Each Obj In ThisDrawing.PaperSpace
 If Obj.ObjectName = "AcDbRasterImage" Then
  [color=red]'Objname = 'Need this code[/color]
  Set RastImg = ThisDrawing.PaperSpace.Item(Objname)
 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


[Bob Wahr]

Code: [Select]

For Each Obj In ThisDrawing.PaperSpace
 If Obj.ObjectName = "AcDbRasterImage" Then
  Set RastImg = ThisDrawing.PaperSpace.Item(Objname)
    Objname = rastimg.name

 End If
Next Obj

[Bob Wahr]

Does AcadObject work for this or should it be ACADEntity? Also, why not use a filtered selection set.  Probably won't matter but if there are a bunch of thingies in your dwg it will be quicker.

[ML]

Hi Bob

Thank you;

Yes, Acadobject or Object will work
From what I have been taught and have learned:
If we declared
Obj as AcadEntity

Then, it will literally interate through EVERY single AutoCAD entity
Lines, blocks, text, polylines, circles and on and on as opposed to just saying
Find the "object" (typeof) (typename =) I need and do something with it

I could do a filtered selection set but these two methods would work in a similar fashion i would think as with this method we are interating for a specific object type not through a drawing of entity types

Mark

[David Hall]

808, I dont know, I thought it required the object

[David Hall]

I could do a filtered selection set but these two methods would work in a similar fashion i would think as with this method we are interating for a specific object type not through a drawing of entity types

Actually, without the filter, you will process every object in paperspace.  Given that paperspace doesn't usually have tons of items, it should go quickly.  If however you were processing modelspace, a filtered selection set would be the way to go

[ML]

Bob

This won't work

Code: [Select]

For Each Obj In ThisDrawing.PaperSpace
 If Obj.ObjectName = "AcDbRasterImage" Then
  Set RastImg = ThisDrawing.PaperSpace.Item(Objname)
    Objname = rastimg.name
 End If
Next Obj

How are we going to know what objname to set too?
I am able to confirm that there is a raster in paperspace but I need to grab its name

Mark

[David Hall]

I think you want
Set RastImg = Obj
ObjName=RastImg.Name

[Bob Wahr]

doh!  yep, that's what I meant.