求ObjectDBX 1.0

兰州人

下面这段程序应用于找尺寸线的块，需要ObjectDBX 1.0 Type Library和Axdb15.dll。请问哪里能得到ObjectDBX 1.0 Type Library

Re: Dimension handles
Not suprising that a hack like that doesn't always
work. This will always work, and doesn't rely on
hacks based on lame assumptions.

Before this will work, you will need to register AxDb15.dll
which is located in the same folder as acad.exe, and you
must include a reference to the "ObjectDBX 1.0 Type Library"
in your project.

Public Function GetDimBlock(Dimension As AcadDimension) As AcadBlock
Dim dbxDoc As New AxDbDocument
Dim Doc As AcadDocument
Set Doc = Dimension.Document
Dim IdPairs As Variant
Dim IdPair As AcadIdPair
Dim ObjArray(0 To 0) As AcadObject
Set ObjArray(0) = Dimension
Doc.CopyObjects ObjArray, dbxDoc.ModelSpace, IdPairs
Dim i As Integer
For i = LBound(IdPairs) To UBound(IdPairs)
Set IdPair = IdPairs(i)
Dim Obj As AcadObject
Set Obj = Doc.ObjectIdToObject(IdPair.Key)
If TypeOf Obj Is AcadBlock Then
Dim ABlock As AcadBlock
Set ABlock = Obj
If Left(ABlock.Name, 2) = "*D" Then
Set GetDimBlock = Obj
Exit Function
End If
End If
Next i
End Function

Public Sub Test()
Dim Dimension As AcadDimension
Utility.GetEntity Dimension, Pt, vbCrLf & "Select dimension: "
Dim DimBlock As AcadBlock
Set Block = GetDimBlock(Dimension)
Debug.Print "Dimension block name = " & Block.Name
End Sub

网站链接http://discussion.autodesk.com/thread.jspa?messageID=382642

sody

官方网站上去找

mccad

兰州人

谢谢，郑先生的指点。

Dim dbxDoc As New AxDbDocument，此条语句已经通过。

但这条语句没通过。Doc.CopyObjects ObjArray, dbxDoc.ModelSpace, IdPairs

要复制多个对象，请使用 CopyObjects 方法，或者创建一个阵列数组，与 Copy 方法配合使用。（要复制选择集中的对象，请遍历选择集并将对象保存到数组中。）遍历数组，分别复制每个对象，然后将新创建的对象收集到第二个数组中。

要将多个对象复制到不同的图形，请使用 CopyObjects 方法并将 Owner 参数设置为该图形的模型空间。

相关帖子：利用ObjectDBX技术导入其它图形中的图层设置和文字样式设置

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=12482&extra=&page=1

Object：MSITStore:C:\Program%20Files\AutoCAD%202004\help\acadauto.chm::/idh_database_object.htm">Database, MSITStore:C:\Program%20Files\AutoCAD%202004\help\acadauto.chm::/idh_document_object.htm">Document
The object or objects this method applies to.

对象：数据库，文件：

对象或对象应用方法

Objects

Variant (array of objects); input-only
The array of primary objects to be copied. All the objects must have the same owner, and the owner must belong to the database or document that is calling this method.

对象：变体变量（对象数组），只读型。初始化目标数组的拷贝，全部目标有相同的owner，owner必须属于同一数据库或文件的调用。

Owner

Variant (a single object); input-only; optional
The new owner for the copied objects. If no owner is specified, the objects will be created with the same owner as the objects in the Objects array.

IDPairs

Variant (array of IDPair objects); input-output; optional
Information on what happened during the copy and translation process.
Input: an empty variant.
Output: an array of IDPair objects.

http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=646

在VBA中可以用CopyObjects方法将对象拷贝到块中。
运用此方法可以进行块的重定义等。
函数原型：RetVal = object.CopyObjects(Objects[, Owner][, IDPairs])
Object：文档对象
Objects：要拷贝的对象集合
Owner：拷贝生成的新对象的宿主对象，可以是块或者另一个文档。
程序示例如下：

Sub Text()

' 创建块

Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")

' 在模型空间添加圆

Dim circleObj As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 0: center(1) = 0: center(2) = 0
radius = 1
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)

' 创建对象集合

Dim objCollection(0 To 0) As Object
Set objCollection(0) = circleObj

' 拷贝对象到块中，并返回新拷贝的对象

Dim retObjects As Variant
retObjects = ThisDrawing.CopyObjects(objCollection, blockObj)

' 插入块到模型空间
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0

Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)

ZoomAll

End Sub

mccad

你的dbxDoc并没有打开的图形，怎么会有ModelSpace