Topic: Image saveas in VBA

[David Hall]

Does anyone know of a way to access image saveas?  Im using raster design 07, but I dont think I have any references set, (Im going to check that next)  Im trying to convert jpg files to binary tif files

[David Hall]

Well I added references to anything that looked like raster, but I still cant figure out how to get to saveas.  I found the setting for 2-bit tif files though

[Jeff_M]

I don't have ARD2007 but ARD2006 has an ActiveX help file. It's not REAL helpful, but there are some examples for SaveAs and Export. Here's the SaveAs:

Code: [Select]

Sub Example_SaveAs()
 
' This example searches through all images in the Current Space and will prompt the
' user to save all images of the RLC type. This routine then uses a Save As call
' to save the image using the appropriate image file type. To test this routine,
' insert at least one RLC image.
 
' This calls a procedure to load Cad Overlay. All procedures that use Cad Overlay
' objects must ensure that Cad Overlay is currently loaded.
 
EXLoadCadOverlay.Example_EXLoadCadOverlay
 
' Declare the necessary variables.
Dim imID As Long ' The Object ID of the images.
Dim imCurName As String ' The currently saved path and name of the image.
Dim imNewName As String ' The new path and name for the image.
Dim I, J As Integer ' For counting.
 
' Declare objects to utilize their respective classes.
Dim coList As AecImageObjectList
Dim coWrite As AecImageWrite
Dim coFileName As AecCoImageInfo
 
' Set the objects to their respective classes.
Set coList = ThisDrawing.Application.GetInterfaceObject("CADOverlay.AecImageObjectList")
Set coWrite = ThisDrawing.Application.GetInterfaceObject("CADOverlay.AecImageWrite")
Set coFileName = ThisDrawing.Application.GetInterfaceObject("CADOverlay.AecCoImageInfo")
 
' Search all images in the current space to determine if they are of type RLC. If they
' are, prompt the user to save that particular image. CurrentSpaceCount is 0 based; set
' I = 0 to CurrentSpaceCount -1. The Image Object ID is passed to the AecCoImageInfo
' object to retrieve the File Name and passed to the AecImageWrite object to write out
' the file with the Save As method.
 
For I = 0 To coList.CurrentSpaceCount - 1
imID = coList.CurrentSpaceObjectID(I)
coWrite.ImageObjectID = imID
coFileName.ImageObjectID = imID
imCurName = coFileName.SavedImageFilePath
If Right(coFileName.SavedImageFilePath, 3) = "rlc" Then
J = J + 1
If MsgBox("Save This Image?", vbYesNo, imCurName) = vbYes Then
coWrite.Format = coRLC
imNewName = "c:\Temp" & J & ".rlc"
coWrite.SaveAs (imNewName)
End If
End If
Next
 
' Formats supported for Save, Save As, and Export are BMP, RLE, DIB, CAL, GP4, RST, MIL,
' CG4, FLC, FLI, JPG, PCX, PNG, RLC (with IST header), TGA, TIF.
 
End Sub
And the help does document that just one reference is needed:

Select Autodesk CAD Overlay 2.0 Type Library from the list.

If CAD Overlay 2.0 Type Library is not displayed then click Browse.. select
c:/Program Files/CO2002/AeciIbCom.tlb making sure that Type Libraries is displayed in the Files of Type drop-down list.

[David Hall]

well im getting closer, now I just have to figure out how to invert an image

[David Hall]

OK, this is super ugly, because I had to use sendcommand 3 times (yea I know), so if anyone can see a way to improve it, Im all open to suggestions.

Code: [Select]

Option Explicit
Public Sub ImgConvert()
    Dim currentline As String, objimg As AcadRasterImage
    Dim inspt(2) As Double
    inspt(0) = 0: inspt(1) = 0: inspt(2) = 0
    Open "c:\jpgconvert.dat" For Input As 1
    While Not EOF(1)
        Line Input #1, currentline
        Set objimg = ThisDrawing.ModelSpace.AddRaster(currentline, inspt, 1, 0)
        ThisDrawing.Regen acAllViewports
        ZoomExtents
        ConvertJPG
        imgdet
    Wend
    Close 1
End Sub
Private Sub imgdet()
    ThisDrawing.SendCommand "-image" & vbCr & "D" & vbCr & "*" & vbCr
End Sub
Private Sub ConvertJPG()
    Dim imgPath As String
    Dim objimg As AcadRasterImage
    Dim imID As Long    ' The Object ID of the images.
    Dim imCurName As String    ' The currently saved path and name of the image.
    Dim imNewName As String    ' The new path and name for the image.
    Dim I, J As Integer    ' For counting.
    ' Declare objects to utilize their respective classes.
    Dim coList As AecImageObjectList
    Dim coFileName As AecCoImageInfo
    Dim coWrite As AecImageWrite
    ' Set the objects to their respective classes.
    Set coList = ThisDrawing.Application.GetInterfaceObject("CADOverlay.AecImageObjectList")
    Set coFileName = ThisDrawing.Application.GetInterfaceObject("CADOverlay.AecCoImageInfo")
    Set coWrite = ThisDrawing.Application.GetInterfaceObject("CADOverlay.AecImageWrite")
    For I = 0 To coList.CurrentSpaceCount - 1
        imID = coList.CurrentSpaceObjectID(I)
        coFileName.ImageObjectID = imID
        coWrite.ImageObjectID = imID
        imCurName = coFileName.SavedImageFilePath
        'imgPath=imCurName
        If Right(imCurName, 3) = "jpg" Then
            J = J + 1
            'If MsgBox("Export This Image?", vbYesNo, imCurName) = vbYes Then
            ' Format each image as a TIFF, add a World File (*.tfw), use an uncompressed
            ' encoding method, Stripped data organization type and Maintain the drawing
            ' link.
            Call imgin
            Call smashitdown
            coWrite.Format = "Tagged Image File Format"
            coWrite.EncodingMethod = "CCITT (Fax) Group 4"
            imNewName = Left(imCurName, Len(imCurName) - 4) & ".tif"
            coWrite.Export (imNewName)
            'End If
        End If
    Next
End Sub
Private Sub imgin()
    ThisDrawing.SendCommand "iinvert" & vbCr
End Sub
Private Sub smashitdown()
    ThisDrawing.SendCommand "_IDEPTH" & vbCr & "B" & vbCr
End Sub


[David Hall]

BTW, raster must be initialized before running this or it will crash hard

[David Hall]

OK, this is super ugly, because I had to use sendcommand 3 times (yea I know)

What, no takers?

[Jeff_M]

Sorry, I looked into it and could find nothing in the Object Model that would allow you to eliminate the SendCommands. I thought I posted that , but evidently I didn't make it that far.

I know that you could remove the Imagedefs by messing with the Image Dictionary, as I wrote a Lisp to detach invalid/unreferenced Images. But the Invert & Depth are beyond what I know about images.

[David Hall]

Thanks Jeff.  I also could not find anything to get rid of the SendCommands.  I was actually pretty bummed, b/c this is the first app I ever HAD to use sendcommand.