VBA中的图像另存为
有谁知道访问图像保存的方法吗？ 我使用光栅设计07，但我认为我没有任何引用集，（我接下来要检查一下）我试图将jpg文件转换为二进制tif文件**** Hidden Message ***** 嗯，我添加了对任何看起来像光栅的东西的引用，但我仍然不知道如何获得saveas。不过，我找到了2位tif文件的设置 我没有ARD2007，但ARD2006有一个ActiveX帮助文件。它没有真正的帮助，但有一些关于SaveAs和导出的示例。这是SaveAs：
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
并且帮助确实记录了只需要一个引用：
好吧，我越来越近了，现在我只需要弄清楚如何反转图像 好吧，这是超级丑陋的，因为我不得不使用sendCommand 3次（是的，我知道），所以如果有人能看到改进它的方法，我愿意接受建议。
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
顺便说一句，光栅必须在运行之前初始化，否则它将严重崩溃
什么，没有接受者？ 抱歉，我研究了一下，在对象模型中找不到任何允许您消除SendCommands的东西。我以为我发了，但显然我没发那么远。
我知道您可以通过篡改图像字典来删除Imagedefs，因为我编写了一个Lisp来分离无效/未引用的图像。但是反转和深度超出了我对图像的了解。 谢谢Jeff。我也找不到任何可以摆脱SendCommand ds的东西。我实际上很沮丧，b/c这是我使用过的第一个使用sendCommand的应用程序。
页:
[1]