- 积分
- 603
- 明经币
- 个
- 注册时间
- 2011-7-31
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 介之推 于 2013-4-9 22:19 编辑
大家好,我想同时绘制两条线,但单独绘制两条线时这两条线是各自分开,我想把这两条放在一起,选择时可以被同时选中。我发现做成“组”或“块”好像都可以。请问“组”和“块”有什么区别?
下面是我找到的生成组的代码,我想通过鼠标在选择一个点后就插入一个组。我想请教如何插入一个已经存在的组?- '插入组
- <CommandMethod("InsertGroup")> _
- Public Sub InsertGroup()
- '' Get the current database and start the Transaction Manager
- Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
- Dim acCurDb As Database = acDoc.Database
- Dim acEd As Editor = acDoc.Editor
- Dim pPtRes As PromptPointResult
- Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
- '' 提示用户选择点
- pPtOpts.Message = vbLf & "选择插入点: "
- pPtRes = acDoc.Editor.GetPoint(pPtOpts)
- Dim InsertPt As Point3d = pPtRes.Value
-
- '' Exit if the user presses ESC or cancels the command
- If pPtRes.Status = PromptStatus.Cancel Then Exit Sub
- Using trans As Transaction = acCurDb.TransactionManager.StartTransaction
- '打开当前数据库的组字典对象以加入新建的组对象
- Dim dict As DBDictionary = trans.GetObject(acCurDb.GroupDictionaryId, OpenMode.ForWrite)
- '定义新建组的名称
- Dim groupName As String = "Name"
- If dict.Contains(groupName) Then
- '如果已经包含了这个组,则插入这个组,---------------请问这个如何实现----------
- Else
- ''新建一个组对象
- Dim gp As New Group(groupName, True)
- '在组字典中将组对象作为一个新条目加入,并指定它的搜索关键字为groupName
- dict.SetAt(groupName, gp)
- '为组添加实体
- Dim Ids As New ObjectIdCollection()
- '添加一条竖直直线
- Dim LineId As ObjectId = AddLine(InsertPt, 90, 200, 2)
- Ids.Add(LineId)
- '添加一条水平直线
- Dim LineIdTwo As ObjectId = AddLine(InsertPt, 0, 200, 2)
- Ids.Add(LineIdTwo)
- '在组对象中加入所选择的对象
- gp.Append(Ids)
- '通知事务处理完成组对象的加入
- trans.AddNewlyCreatedDBObject(gp, True)
- End If
-
- trans.Commit()
- End Using
- End Sub
其中绘制直线的函数如下:
- Public Shared Function AddLine(ByVal centPt As Point3d, ByVal Ang As Double, _
- ByVal Length As Double, ByVal Color As Integer) As ObjectId
- Dim acLine As Line = New Line
- acLine.StartPoint = PolarPoint(centPt, RadToAng(Ang), Length * 0.5)
- acLine.EndPoint = PolarPoint(centPt, RadToAng(Ang) + Math.PI, Length * 0.5)
- acLine.ColorIndex = Color
- 'Add the rectangle polyline entity to model space
- Dim acEntId As ObjectId = AppendEntity(acLine)
- Return acEntId
- End Function
|
|