[编程交流] 创建一个组

 
Public Class Class1
<CommandMethod("selectwindowa")> _
Public Sub selectwindowa()
Dim mydb As Database = HostApplicationServices.WorkingDatabase
Dim mydwg As Document = DocumentManager.MdiActiveDocument
Dim myeditor As Editor = DocumentManager.MdiActiveDocument.Editor
Dim myPPR As Point3d = myeditor.GetPoint("Select 1st Point: ").Value
Dim myPPR1 As Point3d = myeditor.GetCorner("Select 2nd Point: ", myPPR).Value
Dim mypsr As PromptSelectionResult = mydwg.Editor.SelectWindow( _
myPPR, myPPR1)
If mypsr.Status = PromptStatus.OK Then
Using myTrans As Transaction = mydwg.TransactionManager.StartTransaction
For Each myObjectID As ObjectId In mypsr.Value.GetObjectIds
Dim myEnt As Entity = myObjectID.GetObject(OpenMode.ForRead)
'Insert Code Here
Next
End Using
End If
End Sub
　
End Class

 
Public Class Class2
<CommandMethod("CG")> _
Public Sub CreateGroup()
　
　
Dim mydwg As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = mydwg.Database
Dim myeditor As Editor = mydwg.Editor
　
　
　
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Using tr
　
' Get the group dictionary from the drawing
Dim gd As DBDictionary = DirectCast(tr.GetObject(db.GroupDictionaryId, OpenMode.ForRead), DBDictionary)
　
　
' Check the group name, to see whether it's
' already in use
Dim pso As New PromptStringOptions(vbLf & "Enter new group name: ")
pso.AllowSpaces = True
' A variable for the group's name
Dim grpName As String = ""
Do
Dim pr As PromptResult = myeditor.GetString(pso)
　
　
' Just return if the user cancelled
' (will abort the transaction as we drop out of the using
' statement's scope)
If pr.Status <> PromptStatus.OK Then
Return
End If
Try
' Validate the provided symbol table name
SymbolUtilityServices.ValidateSymbolName(pr.StringResult, False)
' Only set the block name if it isn't in use
If gd.Contains(pr.StringResult) Then
myeditor.WriteMessage(vbLf & "A group with this name already exists.")
Else
grpName = pr.StringResult
End If
Catch
　
' An exception has been thrown, indicating the
' name is invalid
myeditor.WriteMessage(vbLf & "Invalid group name.")
　
　
End Try
Loop While grpName = ""
' Create our new group...
　
　
Dim grp As New Group("Test group", True)
' Add the new group to the dictionary
　
　
gd.UpgradeOpen()
Dim grpId As ObjectId = gd.SetAt(grpName, grp)
tr.AddNewlyCreatedDBObject(grp, True)
' Open the model-space
　
Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
　
Dim ms As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
　
　
' Add some lines to the group to form a square
' (the entities belong to the model-space)
Dim ids As New ObjectIdCollection()
Dim ents As DBObjectCollection = Selectobjectsforgroup(0)
For Each ent As Entity In ents
　
Dim id As ObjectId = ms.AppendEntity(ent)
ids.Add(id)
tr.AddNewlyCreatedDBObject(ent, True)
Next
grp.InsertAt(0, ids)
' Commit the transaction
tr.Commit()
' Report what we've done
myeditor.WriteMessage(vbLf & "Created group named ""{0}"" containing {1} entities.", grpName, ents.Count)
End Using
End Sub
Private Function Selectobjectsforgroup(ByVal size As Double) As DBObjectCollection
　
　
　
　
　
Dim mydwg As Document = DocumentManager.MdiActiveDocument
Dim db As Database = mydwg.Database
Dim myeditor As Editor = DocumentManager.MdiActiveDocument.Editor
Dim myPPR As Point3d = myeditor.GetPoint("Select 1st Point: ").Value
Dim myPPR1 As Point3d = myeditor.GetCorner("Select 2nd Point: ", myPPR).Value
Dim mypsr As PromptSelectionResult = mydwg.Editor.SelectWindow( _
myPPR, myPPR1)
If mypsr.Status = PromptStatus.OK Then
Using myTrans As Transaction = mydwg.TransactionManager.StartTransaction
For Each myObjectID As ObjectId In mypsr.Value.GetObjectIds
Dim myEnt As Entity = myObjectID.GetObject(OpenMode.ForRead)
Next
End Using
End If
End Function
　
End Class

 
Public Class Class2
<CommandMethod("CG")> _
Public Sub CreateGroup()
Dim mydwg As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = mydwg.Database
Dim myeditor As Editor = mydwg.Editor
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Using tr
' Get the group dictionary from the drawing
Dim gd As DBDictionary = DirectCast(tr.GetObject(db.GroupDictionaryId, OpenMode.ForRead), DBDictionary)
' Check the group name, to see whether it's
' already in use
Dim pso As New PromptStringOptions(vbLf & "Enter new group name: ")
pso.AllowSpaces = True
' A variable for the group's name
Dim grpName As String = ""
Do
Dim pr As PromptResult = myeditor.GetString(pso)
' Just return if the user cancelled
' (will abort the transaction as we drop out of the using
' statement's scope)
If pr.Status <> PromptStatus.OK Then
Return
End If
Try
' Validate the provided symbol table name
SymbolUtilityServices.ValidateSymbolName(pr.StringResult, False)
' Only set the block name if it isn't in use
If gd.Contains(pr.StringResult) Then
myeditor.WriteMessage(vbLf & "A group with this name already exists.")
Else
grpName = pr.StringResult
End If
Catch
　
' An exception has been thrown, indicating the
' name is invalid
myeditor.WriteMessage(vbLf & "Invalid group name.")
　
　
End Try
Loop While grpName = ""
' Create our new group...
　
　
Dim grp As New Group("Test group", True)
' Add the new group to the dictionary
　
　
gd.UpgradeOpen()
Dim grpId As ObjectId = Selectobjectsforgroup()
tr.AddNewlyCreatedDBObject(grp, True)
' Open the model-space
　
Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
　
Dim ms As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
　
　
' Commit the transaction
tr.Commit()
　
End Using
End Sub
Private Function Selectobjectsforgroup() As ObjectId
Dim mydwg As Document = DocumentManager.MdiActiveDocument
Dim db As Database = mydwg.Database
Dim myeditor As Editor = DocumentManager.MdiActiveDocument.Editor
Dim myPPR As Point3d = myeditor.GetPoint("Select 1st Point: ").Value
Dim myPPR1 As Point3d = myeditor.GetCorner("Select 2nd Point: ", myPPR).Value
Dim mypsr As PromptSelectionResult = mydwg.Editor.SelectWindow( _
myPPR, myPPR1)
If mypsr.Status = PromptStatus.OK Then
Using myTrans As Transaction = mydwg.TransactionManager.StartTransaction
For Each myObjectID As ObjectId In mypsr.Value.GetObjectIds
Dim myEnt As Entity = myObjectID.GetObject(OpenMode.ForWrite)
Next
End Using
End If
End Function
　
End Class