Public Sub GetHatchBorder()
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim lock As DocumentLock = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.LockDocument
' Dim db As Database = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
ed.WriteMessage("选择需要重新生成边界的填充" & vbLf)
Dim acTypValAr(1) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.Start, "Hatch"), 0)
acTypValAr.SetValue(New TypedValue(DxfCode.Visibility, 0), 1)
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
Dim entRes As PromptSelectionResult
Dim errorcn As Integer = 0
Dim errorids As New ObjectIdCollection
Dim errorid As New ObjectId
Dim mycllids As ObjectIdCollection
entRes = ed.GetSelection(acSelFtr)
If entRes.Status <> PromptStatus.OK Then
ed.WriteMessage("选择对象失败,退出")
Return
Else
mycllids = New ObjectIdCollection(entRes.Value.GetObjectIds)
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
For Each objid In mycllids
If Not IsDBNull(objid) Then
Try
Dim ent As Hatch = TryCast(trans.GetObject(objid, OpenMode.ForWrite), Hatch)
errorid = MyDrawBorder(ent, 1)
If Not IsDBNull(errorid) And errorids.Contains(errorid) = False Then
errorids.Add(errorid)
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim lock As DocumentLock = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.LockDocument
' Dim db As Database = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
ed.WriteMessage("选择需要重新生成边界的填充" & vbLf)
Dim acTypValAr(1) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.Start, "Hatch"), 0)
acTypValAr.SetValue(New TypedValue(DxfCode.Visibility, 0), 1)
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
Dim entRes As PromptSelectionResult
Dim errorcn As Integer = 0
Dim errorids As New ObjectIdCollection
Dim errorid As New ObjectId
Dim mycllids As ObjectIdCollection
entRes = ed.GetSelection(acSelFtr)
If entRes.Status <> PromptStatus.OK Then
ed.WriteMessage("选择对象失败,退出")
Return
Else
mycllids = New ObjectIdCollection(entRes.Value.GetObjectIds)
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
For Each objid In mycllids
If Not IsDBNull(objid) Then
Try
Dim ent As Hatch = TryCast(trans.GetObject(objid, OpenMode.ForWrite), Hatch)
errorid = MyDrawBorder(ent, 1)
If Not IsDBNull(errorid) And errorids.Contains(errorid) = False Then
errorids.Add(errorid)