请教如何用选择集取到光栅图像?
请教各位大侠以下的问题:小弟最近用VBA编程时,需要穷举图纸中的所有光栅图像。这是小弟的源代码:
Dim a As AcadSelectionSet
Set a = ThisDrawing.SelectionSets.Add("SSS67ETEXC")
Dim ft(0 To 1) As Integer<BR> Dim fd(0 To 1) As Variant<BR> ft(0) = 0<BR> fd(0) = "IMAGEDEF"<BR> ft(1) = 8<BR> fd(1) = "*"
a.Select acSelectionSetAll, , , ft, fd
关键是选择集的过滤条件 Filter的问题。
这个组码是我将.dwg转换成dxf后查到的。可是用这个方式却怎么也取不到
光栅对象。
请问,如何用选择集取到所有的光栅对象呢?
谢谢各位!
111
"AcDbRasterImage" AcDbRasterImage不行,真是奇怪,难道没人知道吗?版主哪去了? <p></p><p>Public Function ChangeDwgPicPath(AcadObj As AcadApplication, Optional DWGFullName As String = "")<br/></p><p>Dim JJ As Integer<br/>Dim pImg As AcadRasterImage<br/>Dim PEnt As AcadEntity</p><p><br/>Dim pDrive As String<br/>Dim NowChar As String<br/>Dim PicPathName As String<br/>Dim DwgIsOpen As Boolean<br/>'将DWGFullName置为当前<br/>DwgIsOpen = False</p><p>If DWGFullName <> "" Then<br/> For JJ = 0 To AcadObj.Documents.Count - 1<br/> If UCase(AcadObj.Documents(JJ).FullName) = UCase(DWGFullName) Then<br/> DwgIsOpen = True<br/> AcadObj.Documents(JJ).Activate<br/> End If<br/> Next<br/> <br/> If Not DwgIsOpen Then<br/> AcadObj.Documents.Open DWGFullName<br/> End If<br/>End If</p><p>If UCase(AcadObj.ActiveDocument.ActiveLayout.Name) <> "MODEL" Then<br/> AcadObj.ActiveDocument.SetVariable "CTAB", "Model"<br/>End If<br/>'选择图片<br/>Dim SSetObj As AcadSelectionSet<br/> Dim fType, fData As Variant<br/> <br/> <em><strong>BuildFilter fType, fData, 0, "IMAGEDEF"'请问如何选择所有图片?</strong></em></p><p><strong><em> '首先不能用ActiveDocuments.ModesSpace取所有对象,那速度太慢了,</em></strong></p><p> <br/> Set SSetObj = CreateSelectionSet(AcadObj, "Pic")<br/> '选择名称为的所有块<br/> <br/> SSetObj.Select acSelectionSetAll, , , fType, fData<br/> Erase fType: Erase fData<br/> Debug.Print SSetObj.Count<br/>For Each PEnt In SSetObj<br/> If TypeOf PEnt Is AcadRasterImage Then<br/> Set pImg = PEnt<br/> <br/> PicPathName = pImg.ImageFile<br/> <br/> If Mid(pImg.ImageFile, 1, 1) = "." Then<br/> '将相对路径转换为绝对路径<br/> pDrive = Mid(AcadObj.ActiveDocument.FullName, 1, 3)<br/> <br/> For JJ = 1 To Len(PicPathName)<br/> NowChar = Mid(PicPathName, JJ, 1)<br/> If NowChar <> "\" And NowChar <> "." Then<br/> Exit For<br/> End If<br/> Next<br/> <br/> PicPathName = pDrive & Right(PicPathName, Len(PicPathName) - JJ + 1)<br/> <br/> If pFSO.FileExists(PicPathName) Then<br/> pImg.ImageFile = PicPathName<br/> End If<br/> <br/> End If<br/> <br/> <br/> <br/> End If<br/>Next</p><p>End Function</p><p></p>
页:
[1]