.NET

Reply
Active Contributor
chase.hochstrasser
Posts: 42
Registered: ‎07-17-2013
Message 1 of 4 (321 Views)
Accepted Solution

Erase stand alone objects in dwg

321 Views, 3 Replies
09-12-2013 08:25 AM

I would like to remove all the Layers with the name "PLOH*" in them, that do not have anything in the same insertion point. I have been trying to select everything in the crossing window where the point3d's are the same but this does not get them all for some reason. how would someone else do this. I have attached a dwg.

'' Get the current Document, Editor, & Database
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acDocEd As Editor = acDoc.Editor
Dim acCurDb As Database = acDoc.Database

'' Create a TypedValue array to define the filter criteria
Dim acTypValAr() As TypedValue = {New TypedValue(DxfCode.LayerName, "PLOH*")}

'' Assign the filter criteria to a SelectionFilter object
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)

'' Request for objects to be selected in the drawing area
Dim acSSPrompt As PromptSelectionResult = acDocEd.SelectAll(acSelFtr)

'' If the prompt status is OK, objects were selected
If acSSPrompt.Status = PromptStatus.OK Then

'' Get the selected objects
Dim acSSet As SelectionSet = acSSPrompt.Value

'' Step through each layer and update those not connected to another device
For Each acObjId As ObjectId In acSSet.GetObjectIds()

'' Start Transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction

'' Get entity of object
Dim acEnt As Entity = acTrans.GetObject(acObjId, OpenMode.ForRead)

'' Check type of entity
If TypeOf (acEnt) Is BlockReference Then

'' Case Entity to Block Reference
Dim acBlkRef As BlockReference = DirectCast(acEnt, BlockReference)

'' Select anything found at the sampe points
Dim p1 As Point3d = New Point3d(acBlkRef.Position.X - 10, acBlkRef.Position.Y - 10, 0)
Dim p2 As Point3d = New Point3d(acBlkRef.Position.X + 10, acBlkRef.Position.Y + 10, 0)
Dim acTypValAr2() As TypedValue = {New TypedValue(DxfCode.Operator, "<AND"),
New TypedValue(DxfCode.Operator, ">,>,*"),
New TypedValue(DxfCode.XCoordinate, p1),
New TypedValue(DxfCode.Operator, "<,<,*"),
New TypedValue(DxfCode.XCoordinate, p2),
New TypedValue(DxfCode.Operator, "AND>")}

'' Create a filter from type value
acSelFtr = New SelectionFilter(acTypValAr2)

'' Get all objects in cross window using filter and select anything at the same point
acSSPrompt = acDocEd.SelectAll(acSelFtr)

'' Check if prompt is good and items were found
If acSSPrompt.Status = PromptStatus.OK Then

'' Apply results to make a selection set
Dim acSSet2 As SelectionSet = acSSPrompt.Value

'' Check if one or more items were found
If acSSet2.Count = 1 Then
'' Upgrade to Write-able
acBlkRef.UpgradeOpen()

'' Erase block reference from drawing
acBlkRef.Erase()
End If

'' Set selection set 2 to nothing
acSSet2 = Nothing
ElseIf acSSPrompt.Status = PromptStatus.Error Then
acDocEd.WriteMessage("FAILED to auto select * w/ PLOH* " & vbCrLf)
Exit Sub
End If
End If
acTrans.Commit()
End Using
Next
End If

Active Contributor
chase.hochstrasser
Posts: 42
Registered: ‎07-17-2013
Message 2 of 4 (315 Views)

Re: Erase stand alone objects in dwg

09-12-2013 09:08 AM in reply to: chase.hochstrasser
basically i want to select objects that are not close to anything else. so if the distance is between an object and another object is greater than 0.01 then erase it.
Active Contributor
chase.hochstrasser
Posts: 42
Registered: ‎07-17-2013
Message 3 of 4 (302 Views)

Re: Erase stand alone objects in dwg

09-12-2013 10:01 AM in reply to: chase.hochstrasser

I changed my code to use the database method instead of the Selection method to find the objects, but this will remove all block references with the name PLOH, i would like to change this to only the PLOH that are by themself not connected to anything else.

 

'' Start a Transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction
'' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
For Each id_blk As ObjectId In acBlkTbl
'' Open the Block table record Model space for write
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(id_blk, OpenMode.ForWrite)
Dim acObjCol As ObjectIdCollection = acBlkTblRec.GetBlockReferenceIds(True, True)
For Each id As ObjectId In acObjCol
Dim acBlkRef As BlockReference = acTrans.GetObject(id, OpenMode.ForWrite)
If acBlkRef.Layer.Contains("PLOH") Then
acBlkRef.Erase()
End If
Next
Next
'' Save the changes and dispose of the transaction
acTrans.Commit()
End Using

Active Contributor
chase.hochstrasser
Posts: 42
Registered: ‎07-17-2013
Message 4 of 4 (290 Views)

Re: Erase stand alone objects in dwg

09-12-2013 11:27 AM in reply to: chase.hochstrasser

'' Get the current Document, Editor, & Database
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acDocEd As Editor = acDoc.Editor
Dim acCurDb As Database = acDoc.Database

'' Create a TypedValue array to define the filter criteria
Dim acTypValAr() As TypedValue = {New TypedValue(DxfCode.LayerName, "PLOH*")}

'' Assign the filter criteria to a SelectionFilter object
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)

'' Request for objects to be selected in the drawing area
Dim acSSPrompt As PromptSelectionResult = acDocEd.SelectAll(acSelFtr)

'' If the prompt status is OK, objects were selected
If acSSPrompt.Status = PromptStatus.OK Then

'' Get the selected objects
Dim acSSet As SelectionSet = acSSPrompt.Value

'' Step through each layer and update those not connected to another device
For Each acObjId As ObjectId In acSSet.GetObjectIds()

'' Start Transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction

'' Get entity of object
Dim acEnt As Entity = acTrans.GetObject(acObjId, OpenMode.ForRead)

'' Check type of entity
If TypeOf (acEnt) Is BlockReference Then

'' Case Entity to Block Reference
Dim acBlkRef As BlockReference = DirectCast(acEnt, BlockReference)

'' Select anything found at the sampe points
Dim p1 As Point3d = New Point3d(acBlkRef.Position.X - 10, acBlkRef.Position.Y - 10, 0)
Dim p2 As Point3d = New Point3d(acBlkRef.Position.X + 10, acBlkRef.Position.Y + 10, 0)
Dim acTypValAr2() As TypedValue = {New TypedValue(DxfCode.Operator, "<AND"),
New TypedValue(DxfCode.Operator, ">,>,*"),
New TypedValue(DxfCode.XCoordinate, p1),
New TypedValue(DxfCode.Operator, "<,<,*"),
New TypedValue(DxfCode.XCoordinate, p2),
New TypedValue(DxfCode.Operator, "AND>")}

'' Create a filter from type value
acSelFtr = New SelectionFilter(acTypValAr2)

'' Get all objects in cross window using filter and select anything at the same point
acSSPrompt = acDocEd.SelectAll(acSelFtr)

'' Check if prompt is good and items were found
If acSSPrompt.Status = PromptStatus.OK Then

'' Apply results to make a selection set
Dim acSSet2 As SelectionSet = acSSPrompt.Value

'' Check if one or more items were found
If acSSet2.Count = 1 Then
'' Upgrade to Write-able
acBlkRef.UpgradeOpen()

'' Erase block reference from drawing
acBlkRef.Erase()
End If

'' Set selection set 2 to nothing
acSSet2 = Nothing
ElseIf acSSPrompt.Status = PromptStatus.Error Then
acDocEd.WriteMessage("FAILED to auto select * w/ PLOH* " & vbCrLf)
Exit Sub
End If
End If
acTrans.Commit()
End Using
Next
End If

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Do you have 60 seconds to spare? The Autodesk Community Team is revamping our site ranking system and we want your feedback! Please click here to launch the 5 question survey. As always your input is greatly appreciated.