.NET
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Erase stand alone objects in dwg

3 REPLIES 3
SOLVED
Reply
Message 1 of 4
chase.hochstrasser
581 Views, 3 Replies

Erase stand alone objects in dwg

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.

3 REPLIES 3
Message 2 of 4

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.
Message 3 of 4

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

Message 4 of 4

'' 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

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk DevCon in Munich May 28-29th


Autodesk Design & Make Report

”Boost