利用ObjectDbx预览块图像

雪山飞狐_lzh

Private pFileName As String
Private objDbx As AxDbDocument
Public Names As New Collection Private Sub Class_Initialize() Set objDbx = GetInterfaceObject("ObjectDBX.AxDbDocument.16")

End Sub Public Function GetBlock(ByVal BlockName As String) As AcadBlock
'将文件中的块读入当前图形 Dim pBlock As AcadBlock
Dim pnt(2) As Double
Dim pObjs() As AcadEntity

Set pBlock = objDbx.Blocks(BlockName)

ReDim pObjs(pBlock.Count - 1) As AcadEntity

For i = 0 To pBlock.Count - 1
Set pObjs(i) = pBlock(i)
Next i

Set GetDbxBlock = ThisDrawing.Blocks.Add(pnt, "*U")
objDbx.CopyObjects pObjs, GetDbxBlock

End Function Public Function GetBlockImage(ByVal BlockName As String) As IPictureDisp
'获取块的预览图像 Dim pObj(0) As AcadEntity
Dim pnt(2) As Double
Dim ss As AcadSelectionSet

Set pObj(0) = objDbx.ModelSpace.InsertBlock(pnt, BlockName, 1, 1, 1, 0)
objDbx.CopyObjects pObj, ThisDrawing.ModelSpace

Set pObj(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
pObj(0).GetBoundingBox d1, d2

ThisDrawing.Application.ZoomWindow d1, d2

On Error Resume Next
ThisDrawing.SelectionSets("*TlsDbx*").Delete
Set ss = ThisDrawing.SelectionSets.Add("*TlsDbx*")
ss.AddItems pObj

ThisDrawing.Export "c:\Temp", "wmf", ss
ss.Delete
pObj(0).Delete
ThisDrawing.Blocks(BlockName).Delete
ThisDrawing.Application.ZoomPrevious

Set GetBlockImage = LoadPicture("c:\temp.wmf")
Kill "c:\temp.wmf"

End Function
Public Property Let FileName(ByVal str As String)
'打开文件 Dim i As AcadBlock pFileName = str
objDbx.Open str

Set Names = New Collection

For Each i In objDbx.Blocks
If Not (i.IsLayout Or i.IsXRef) Then
Names.Add i.Name
End If
Next i End Property 上述代码存为TlsDbx类 插入一个窗体 加入ListBox控件和Image控件 在窗体加入下列代码 Dim a As New TlsDbx Private Sub ListBox1_Click()
Set Me.Image1.Picture = a.GetBlockImage(ListBox1.Text) End Sub Private Sub UserForm_Activate()
a.FileName = "d:\ccd.dwg"
For Each i In a.Names
Me.ListBox1.AddItem i
Debug.Print i
Next i
End Sub

mikewolf2k

太好了，试试看

nxy_918

强大！！！ ObjectDbx看来要好研究研究 关注ing

leer

可是预览那一块似乎不好用，算法好像是把图插入当前图然后输出为wmf再导入图形控件中，预览不完善而且觉得这样的过程似乎有点麻烦，有没有更好的方法呢？

yicol

Private objDbx As AxDbDocument 此句无效，是为什么

liufx2000

上述代码存为TlsDbx类？以上所有的代码么？不好意思水平比较差

雪山飞狐_lzh

yicol发表于2004-8-21 15:03:00Private objDbx As AxDbDocument 此句无效，是为什么

引用DBX

yicol

不行啊，版主，看到了文件生成，但那个图元文件是没有图像的，在窗体中预览不到，另外我在原文件中确定块是正常的，单击list后没有任何反应

tonyhuangg

我正准备用objectdbx在不打开autocad情况下读取dwg里图框里的文字信息，能举一例子或提示用哪些方法和属性可以成功吗，（不熟cad编程，但要马上交货了，盼能得到您的帮助），谢谢，我是用vb开发的。

雪山飞狐_lzh

不打开autocad，objectdbx也干不了，：）