PDA

View Full Version : AutoCAD 2004 - Selecting and Deleting Blocks



PellaCAD
06-07-2006, 07:59 AM
Greetings to all!

I am just beginning with my ACAD-VBA education and I need some help!

I need to delete all occurances of "BlockXYZ" if attribute "Title" has a "?" in it...

Thanks so much for any help!

Pete

malik641
06-20-2006, 08:05 PM
hey PellaCAD, welcome to the forums :hi:

I'm learning VBA for AutoCAD as well....and this is all I could come up with.

It works when you select each block individually....I can't seem to get it to work by searching throughout the whole drawing for each block reference..but anyway take a look, maybe it'll push start you to what you're looking for:

Option Explicit
Option Compare Text

Sub DeleteBlockXYZ()
On Error Resume Next
Dim objBRef As AcadBlockReference
Dim varPick As Variant
Dim objEnt As Object
Dim varAttribs As Variant
Dim intI As Integer

ThisDrawing.Utility.GetEntity objEnt, varPick, "Get object"
Set objBRef = objEnt
If objBRef.HasAttributes And Not objBRef Is Nothing Then
varAttribs = objBRef.GetAttributes
For intI = LBound(varAttribs) To UBound(varAttribs)
If varAttribs(intI).TagString = "Title" And _
varAttribs(intI).TextString = "?" Then
objBRef.Delete
End If
Next
End If

Set objBRef = Nothing
End Sub

Tell me what you think :thumb

PellaCAD
06-21-2006, 05:22 AM
Thanks malik641!

I think that will get me going quite nicely!!

lucas
06-21-2006, 06:35 AM
Will have to wait for Tommy to confirm but I think you can use a selectionset:

Dim adSS As AcadSelectionSet

Set adSS = ThisDrawing.SelectionSets.Add("adSS")
If Err Then Set adSS = ThisDrawing.SelectionSets.Add("adSS")
adSS.Clear

malik641
06-23-2006, 05:38 AM
Hey Steve,

How does adding the selection set work exactly?

lucas
06-23-2006, 06:07 AM
Don't quote me Joseph but as I understand it....it should allow you to make multiple selections....facing a deadline so don't have time to go into depth on this right now but will asap. Tommy is the resident cad vba guy. Maybe he will make an appearance soon.

malik641
06-23-2006, 06:26 AM
Thanks Steve, I'll look into it after work :thumb

And I haven't seen Tommy in a while :think: Where are ya buddy!?

Tommy
08-05-2006, 11:14 AM
This will do the same a Joseph's code.

The difference as Steve said I used a selection set, I got the document properties/limits and used that as points to the selection instead of select on screen. So what all this means is the macro runs selecting all inserted blocks, checks for attibutes, if it has them, checks fot "Title" and "?" if there deletes them, otherwise it ignores the "inserts".

Sub FindBlockWithAttributes()
Dim mI As Long, mBlkRef As AcadBlockReference
Dim mTemp As Variant
Dim pt(1), pt1(1)
Dim groupCode As Variant, dataCode As Variant
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim ssetA As AcadSelectionSet
On Error Resume Next
'make a selection set making sure it doesn't exist
Set ssetA = ThisDrawing.SelectionSets.Add("BlkSet")
If Err.Number <> 0 Then
Set ssetA = ThisDrawing.SelectionSets("BlkSet")
ssetA.Delete
Set ssetA = ThisDrawing.SelectionSets.Add("BlkSet")
Err.Clear
End If
'set the selection set criteria
gpCode(0) = 0
dataValue(0) = "Insert"
groupCode = gpCode
dataCode = dataValue
AcadApplication.Visible = acTrue
ThisDrawing.Regen acActiveViewport
'get the points for use in generating the selection set
pt(0) = ThisDrawing.Limits(0): pt(1) = ThisDrawing.Limits(1)
pt1(0) = ThisDrawing.Limits(2): pt1(1) = ThisDrawing.Limits(3)
ssetA.Select acSelectionSetAll, pt, pt1, groupCode, dataCode
'now to itterate though the selecton set for inserts
For Each mBlkRef In ssetA
'check for attributes
If mBlkRef.HasAttributes Then
'get the little buggers
mTemp = mBlkRef.GetAttributes
For mI = LBound(mTemp) To UBound(mTemp)
'some blocks have more than one so check all of them
If mTemp(mI).TextString = "?" And _
mTemp(mI).TagString = "Title" Then
'bad block you have to go
mBlkRef.Delete
Exit For
End If
Next
'leave no leftovers
Erase mTemp
End If
Next
'trying to clean up a little
ssetA.Delete
Set ssetA = Nothing
End Sub