请教如何用选择集取到光栅图像？

evaporated

请教各位大侠以下的问题： 小弟最近用VBA编程时，需要穷举图纸中的所有光栅图像。这是小弟的源代码： Dim a As AcadSelectionSet Set a = ThisDrawing.SelectionSets.Add("SSS67ETEXC") Dim ft(0 To 1) As Integer
Dim fd(0 To 1) As Variant
ft(0) = 0
fd(0) = "IMAGEDEF"
ft(1) = 8
fd(1) = "*" a.Select acSelectionSetAll, , , ft, fd 关键是选择集的过滤条件 Filter的问题。 这个组码是我将.dwg转换成dxf后查到的。可是用这个方式却怎么也取不到 光栅对象。 请问，如何用选择集取到所有的光栅对象呢？ 谢谢各位！

hnz

"AcDbRasterImage"

JimPan

AcDbRasterImage不行,真是奇怪,难道没人知道吗?版主哪去了?

JimPan

Public Function ChangeDwgPicPath(AcadObj As AcadApplication, Optional DWGFullName As String = "")

Dim JJ As Integer
Dim pImg As AcadRasterImage
Dim PEnt As AcadEntity

Dim pDrive As String
Dim NowChar As String
Dim PicPathName As String
Dim DwgIsOpen As Boolean
'将DWGFullName置为当前
DwgIsOpen = False

If DWGFullName <> "" Then
    For JJ = 0 To AcadObj.Documents.Count - 1
        If UCase(AcadObj.Documents(JJ).FullName) = UCase(DWGFullName) Then
            DwgIsOpen = True
            AcadObj.Documents(JJ).Activate
        End If
    Next
   
    If Not DwgIsOpen Then
        AcadObj.Documents.Open DWGFullName
    End If
End If

If UCase(AcadObj.ActiveDocument.ActiveLayout.Name) <> "MODEL" Then
    AcadObj.ActiveDocument.SetVariable "CTAB", "Model"
End If
'选择图片
Dim SSetObj As AcadSelectionSet
    Dim fType, fData As Variant
   
     BuildFilter fType, fData, 0, "IMAGEDEF"'请问如何选择所有图片?

     '首先不能用ActiveDocuments.ModesSpace取所有对象,那速度太慢了,

   
    Set SSetObj = CreateSelectionSet(AcadObj, "Pic")
    '选择名称为的所有块
   
    SSetObj.Select acSelectionSetAll, , , fType, fData
    Erase fType: Erase fData
    Debug.Print SSetObj.Count
For Each PEnt In SSetObj
    If TypeOf PEnt Is AcadRasterImage Then
        Set pImg = PEnt
       
        PicPathName = pImg.ImageFile
       
        If Mid(pImg.ImageFile, 1, 1) = "." Then
            '将相对路径转换为绝对路径
            pDrive = Mid(AcadObj.ActiveDocument.FullName, 1, 3)
           
            For JJ = 1 To Len(PicPathName)
                NowChar = Mid(PicPathName, JJ, 1)
                If NowChar <> "\" And NowChar <> "." Then
                    Exit For
                End If
            Next
           
            PicPathName = pDrive & Right(PicPathName, Len(PicPathName) - JJ + 1)
       
            If pFSO.FileExists(PicPathName) Then
                pImg.ImageFile = PicPathName
            End If
       
        End If
       
       
       
    End If
Next

End Function