Consulting

Results 1 to 8 of 8

Thread: AutoCAD 2004 - Selecting and Deleting Blocks

  1. #1
    VBAX Newbie
    Joined
    Jun 2006
    Posts
    2
    Location

    AutoCAD 2004 - Selecting and Deleting Blocks

    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
    Last edited by PellaCAD; 06-07-2006 at 08:01 AM. Reason: Title is not complete

  2. #2
    Administrator
    2nd VP-Knowledge Base
    VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    hey PellaCAD, welcome to the forums

    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:

    [VBA]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[/VBA]

    Tell me what you think




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  3. #3
    VBAX Newbie
    Joined
    Jun 2006
    Posts
    2
    Location
    Thanks malik641!

    I think that will get me going quite nicely!!

  4. #4
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    Will have to wait for Tommy to confirm but I think you can use a selectionset:
    [VBA]
    Dim adSS As AcadSelectionSet

    Set adSS = ThisDrawing.SelectionSets.Add("adSS")
    If Err Then Set adSS = ThisDrawing.SelectionSets.Add("adSS")
    adSS.Clear
    [/VBA]
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  5. #5
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Hey Steve,

    How does adding the selection set work exactly?




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  6. #6
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    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.
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  7. #7
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Thanks Steve, I'll look into it after work

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




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  8. #8
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location

    Selection Set Method

    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".

    [VBA]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
    [/VBA]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •