evaporated 发表于 2005-6-14 22:30:00

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

请教各位大侠以下的问题:
小弟最近用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 发表于 2006-7-9 11:35:00

"AcDbRasterImage"

JimPan 发表于 2007-4-24 22:44:00

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

JimPan 发表于 2007-4-24 22:55:00

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
页: [1]
查看完整版本: 请教如何用选择集取到光栅图像?