请教如何用选择集取到光栅图像?
请教各位大侠以下的问题:小弟最近用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后查到的。可是用这个方式却怎么也取不到
光栅对象。
请问,如何用选择集取到所有的光栅对象呢?
谢谢各位! "AcDbRasterImage" AcDbRasterImage不行,真是奇怪,难道没人知道吗?版主哪去了? 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]