创建一个组
下面的代码选择图形中的图元。我现在需要创建一个名为groupa mad up的新组，该组由选定的实体组成。
我需要在代码中添加什么
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
我现在有一些代码可以创建一个组
但我收到一条警告信息，上面写着
“Function”selectobjectsforgroup“不会在所有代码路径上返回值
使用结果时，运行时可能会发生空引用异常。”
我已经运行了代码，它导致autocad崩溃。
我需要做什么改变
这是我到目前为止的代码
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
我现在有了一个代码，它更接近于对我选择的对象进行分组。
唯一的问题是，当我运行它时，autocad中出现了一个错误，即
“应用程序中的组件发生未处理的异常”
我该如何修复它？
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
页:
[1]