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<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后查到的。可是用这个方式却怎么也取不到


光栅对象。


请问,如何用选择集取到所有的光栅对象呢?


谢谢各位!

hnz 发表于 2006-7-9 11:35:00

111

"AcDbRasterImage"

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

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

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

<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 &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp; For JJ = 0 To AcadObj.Documents.Count - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If UCase(AcadObj.Documents(JJ).FullName) = UCase(DWGFullName) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DwgIsOpen = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; AcadObj.Documents(JJ).Activate<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; If Not DwgIsOpen Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; AcadObj.Documents.Open DWGFullName<br/>&nbsp;&nbsp;&nbsp; End If<br/>End If</p><p>If UCase(AcadObj.ActiveDocument.ActiveLayout.Name) &lt;&gt; "MODEL" Then<br/>&nbsp;&nbsp;&nbsp; AcadObj.ActiveDocument.SetVariable "CTAB", "Model"<br/>End If<br/>'选择图片<br/>Dim SSetObj As AcadSelectionSet<br/>&nbsp;&nbsp;&nbsp; Dim fType, fData As Variant<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; <em><strong>BuildFilter fType, fData, 0, "IMAGEDEF"'请问如何选择所有图片?</strong></em></p><p><strong><em>&nbsp;&nbsp;&nbsp;&nbsp; '首先不能用ActiveDocuments.ModesSpace取所有对象,那速度太慢了,</em></strong></p><p>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Set SSetObj = CreateSelectionSet(AcadObj, "Pic")<br/>&nbsp;&nbsp;&nbsp; '选择名称为的所有块<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; SSetObj.Select acSelectionSetAll, , , fType, fData<br/>&nbsp;&nbsp;&nbsp; Erase fType: Erase fData<br/>&nbsp;&nbsp;&nbsp; Debug.Print SSetObj.Count<br/>For Each PEnt In SSetObj<br/>&nbsp;&nbsp;&nbsp; If TypeOf PEnt Is AcadRasterImage Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set pImg = PEnt<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; PicPathName = pImg.ImageFile<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Mid(pImg.ImageFile, 1, 1) = "." Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '将相对路径转换为绝对路径<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pDrive = Mid(AcadObj.ActiveDocument.FullName, 1, 3)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For JJ = 1 To Len(PicPathName)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NowChar = Mid(PicPathName, JJ, 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If NowChar &lt;&gt; "\" And NowChar &lt;&gt; "." Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit For<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; PicPathName = pDrive &amp; Right(PicPathName, Len(PicPathName) - JJ + 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If pFSO.FileExists(PicPathName) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pImg.ImageFile = PicPathName<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; End If<br/>Next</p><p>End Function</p><p></p>
页: [1]
查看完整版本: 请教如何用选择集取到光栅图像?