PDA

View Full Version : Vanishing images when vb clipped



10west
11-13-2006, 01:15 PM
Set ent3 = Thisdrawing.HandleToObject(eh)
ent3.ClipBoundary clipPoints

Alright, I'm clipping an image and all is fine, I send it a polygon array, and the image is masked. But, unforyunately it dissappears, and I find a spec way out in the middle od nowhere, wheb you put clippingenabled = false, it shows up where I selected it in the very beginning.
Is this an acad bug? 2000:igiveup: , 2004 :igiveup:, 2007??? has anyone had clipped images, which clip fine manually, just dissappear in vb? I was waiting a while to do this, and now it works, but it doesn't. Even different formats.... thanks:banghead:

10west
12-30-2006, 01:54 PM
Talking to myself here, fyi, well this one even stumps Autodesk, one of those applicational nitemares, they can't even solve... better see what John Walker is doing, Earth to John, Earth to John...help
www.fourmilab.ch (http://www.fourmilab.ch)

fixo
12-30-2006, 04:43 PM
Make sure you used for polygon boundary an
array of 2D points and add these lines after:

ent3.ClippingEnabled = True
ThisDrawing.Regen acActiveViewport

Hth

~'J'~

fixo
12-30-2006, 09:56 PM
I guess where is a mistake there
You need to pass the first point twice!
See how this will be works for you


Option Explicit
'' Solved
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''
'' Getpoint loop example by TT (Tony Tanzillo)
'' request check "Break on Unhandled Errors" in General options
'' on Error Trapping Frame

Sub ClipExample()
Dim oEnt As AcadEntity
Dim oImage As AcadRasterImage
Dim ptArr() As Double, varPt As Variant
Dim i As Integer, j As Integer
Dim Msg As String
ThisDrawing.Utility.GetEntity oEnt, varPt, "Select image"
If TypeOf oEnt Is AcadRasterImage Then
Set oImage = oEnt
End If
Msg = vbCrLf & "First point: "
Dim MyPoint As Variant
j = 0: i = 0
Do While i < 6
i = i + 1
On Error Resume Next
MyPoint = ThisDrawing.Utility.GetPoint(, Msg)
If Err Then
Err.Clear
Exit Do
Else
ReDim Preserve ptArr(j + 1)
ptArr(j) = MyPoint(0): ptArr(j + 1) = MyPoint(1)
j = j + 2
End If
On Error GoTo 0
Msg = vbCrLf & "Next point or ENTER to exit: "
Loop
On Error GoTo 0
j = UBound(ptArr) + 2
ReDim Preserve ptArr(j)
ptArr(j - 1) = ptArr(0): ptArr(j) = ptArr(1)
oImage.ClippingEnabled = True
oImage.ClipBoundary ptArr
ThisDrawing.Regen acActiveViewport
End Sub


~'J'~