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

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

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

发表回复

精选推荐