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