- 积分
- 73549
- 明经币
- 个
- 注册时间
- 2001-6-7
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2003-2-3 21:30:00
|
显示全部楼层
可以利用XData(扩展数据)来实现这个功能
1.在利用程序画完直线后,应该将直线的ObjectID保存在图块的XData中。下面的例子看看怎样将直线的ID保存下来,你自己把内容写到你的程序中:
'将Entity1对象的ObjectID保存到Entity2对象的XData中的函数
Function SetObjectIDtoNextEntXData (Entity1 As AcadEntity, Entity2 As AcadEntity)
Dim Entity1 As AcadEntity
Dim BlkXType(0 To 1) As Integer
Dim BlkXValue(0 To 1) As Variant
BlkXType(0) = 1001: BlkXValue(0) = "BlkAttLine"
BlkXType(1) = 1071: BlkXValue(1) = Entity1.ObjectID
Entity2.SetXData BlkXType, BlkXValue
End Function
2.下面的程序可以实现你的功能了:
Private Sub AcadDocument_ObjectModified(ByVal Object As Object)
Dim Entity As AcadObject
Set Entity = Object
Dim BlkXValue As Variant
Dim BlkXType As Variant
Dim LineID As Long
Dim LineEntity As AcadEntity
If Entity.ObjectName = "AcDbBlockReference" Then
Entity.GetXData "BlkAttLine", BlkXType, BlkXValue
If IsArray(BlkXType) Then
LineID = BlkXValue(1)
Set LineEntity = ThisDrawing.ObjectIdToObject(LineID)
LineEntity.Move LineEntity.StartPoint, Entity.InsertionPoint
End If
End If
End Sub
另外,你可以设置更多的条件限制,如图块名称的限制。 |
|