- 积分
- 8579
- 明经币
- 个
- 注册时间
- 2004-6-10
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
只是最后一组坐标编成组,其它的没变.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click '坐标标注
Dim docLock As DocumentLock = Core.Application.DocumentManager.MdiActiveDocument.LockDocument() '“非模态窗口,要锁定文档”
NativeMethods.SetFocus(Core.Application.DocumentManager.MdiActiveDocument.Window.Handle) 'CAD获得焦点
Dim entYId As ObjectId
Dim entXId As ObjectId
Dim psr As PromptSelectionResult '请求在图形区域选择对象
psr = ed.GetSelection() '屏幕选取
Dim SetA As SelectionSet
If psr.Status = PromptStatus.OK Then '如果提示状态OK,表示对象已选
SetA = psr.Value
For Each obj In SetA
Using cTrans As Transaction = db.TransactionManager.StartTransaction() '开启事务处理
Dim entity As Entity = CType(cTrans.GetObject(obj.ObjectId, OpenMode.ForWrite, True), Entity)
Select Case entity.GetType.Name
Case "DBPoint"
Dim Poline As DBPoint = CType(cTrans.GetObject(obj.ObjectId, OpenMode.ForRead, True), DBPoint) '获取点实体对象
' MsgBox(666)
Dim XYZ As Point3d = Poline.Position
Dim entX As New DBText With {
.TextString = XYZ.Y, 'X 文本
.Position = XYZ, '三维点
.ColorIndex = 3,
.Rotation = 0, '文字旋转角度
.Height = 0.3 '文字高度
}
entXId = AppendEntity(entX) '显示X
Dim entY = New DBText With {
.TextString = XYZ.X,'Y 文本
.Position = XYZ, '三维点
.ColorIndex = 6,
.Rotation = 0, '文字旋转角度
.Height = 0.3, '文字高度
.VerticalMode = TextVerticalMode.TextTop, '对齐
.AlignmentPoint = XYZ '设置对齐点
}
entYId = AppendEntity(entY) '显示X
'========组===================================================================
Dim groupName As String = "MyGroup"
Using Trans As Transaction = db.TransactionManager.StartTransaction
Dim gp As New Group(groupName, True)
Dim dict As DBDictionary = Trans.GetObject(db.GroupDictionaryId, OpenMode.ForWrite)
dict.SetAt(groupName, gp)
Dim ids As New ObjectIdCollection From {
entXId,
entYId
}
gp.Append(ids)
Trans.AddNewlyCreatedDBObject(gp, True)
Trans.Commit()
End Using
'===========================================================================
Case Else
End Select
cTrans.Commit()
End Using
Next
End If
docLock.Dispose()
End Sub
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|