SS filtering problems

Discussion in 'AutoCAD' started by perry, May 19, 2004.

  1. perry

    perry Guest

    Im trying to create a selection set which contains specific blocks residing
    on the current layout tab. This was fairly simple with lisp but vba is
    frustrating me
    I've tried it with the "<AND"s and without, no luck. As soon as I remove the
    the layout criteria though, it works.
    Can anyone tell me whats wrong with this code???
    Danke
    --
    Perry Leets
    Inovec Optimization and Control Systems
    Eugene, Oregon
    ----------------------------------------------------------------------------
    ------------------
    Private Sub Class_Initialize()
    'CHECKFUNC
    'theres gotta be a better way to do this

    'Called by -> "main-TBinit"
    'attach to AutoCAD
    Dim ObjAcad As Object
    Dim ObjDoc As Object
    Set ObjAcad = GetObject(, "AutoCAD.Application")
    Set ObjDoc = ObjAcad.ActiveDocument
    Dim Objblock As AcadBlock
    Dim SS As AcadSelectionSet
    Dim FoundTblock As Boolean
    Dim mode As Integer
    Dim PT1(0 To 2) As Double
    Dim PT2(0 To 2) As Double
    Dim FType(0 To 3) As Integer
    Dim FGroup(0 To 3) As Variant
    Dim Filter1 As Variant
    Dim Filter2 As Variant
    Dim CTab As Variant
    CTab = ObjDoc.GetVariable("ctab")

    For Each Objblock In ObjDoc.Blocks
    If UCase(Left(Objblock.Name, 6)) = "TITLE-" Then
    FoundTblock = True
    Exit For
    End If
    Next Objblock
    If FoundTblock Then
    'Create a new selection set.
    On Error Resume Next
    Set SS = ObjDoc.SelectionSets.Add("TITLEBLOCKS")
    If Err.Number <> 0 Then
    Set SS = ObjDoc.SelectionSets.Item("TITLEBLOCKS")
    Err.Clear
    End If
    On Error GoTo 0
    SS.Clear

    PT1(0) = 0: PT1(1) = 0: PT1(2) = 0
    PT2(0) = 3: PT2(1) = 3: PT2(2) = 0

    FType(0) = -4: FGroup(0) = "<AND"
    FType(1) = 2: FGroup(1) = Objblock.Name
    FType(2) = 410: FGroup(2) = CTab
    FType(3) = -4: FGroup(3) = "AND>"

    'Selection mode, 5 = select all
    mode = 5
    Filter1 = FType
    Filter2 = FGroup
    SS.Select mode, PT1, PT2, Filter1, Filter2
    'If a block is found
    If SS.Count >= 1 Then
    Set ObjBlockRef = SS.Item(0)
    varAttributeArray = ObjBlockRef.GetAttributes ' get its
    attributes
    m_sName = Objblock.Name
    End If
    End If
    End Sub
     
    perry, May 19, 2004
    #1
  2. perry

    Joe Sutphin Guest

    You cannot filter on 410 group code.
     
    Joe Sutphin, May 19, 2004
    #2
  3. perry

    perry Guest

    Not really what I wanted to hear Joe!
    I was able to do it with lisp, why not VBA?
    Is there any way I can get a block which exists on a particular layout?
     
    perry, May 19, 2004
    #3
  4. Iterate thru the Layout's Block property, finding the desired BlockReference
    object.

    --
    R. Robert Bell


    Not really what I wanted to hear Joe!
    I was able to do it with lisp, why not VBA?
    Is there any way I can get a block which exists on a particular layout?
     
    R. Robert Bell, May 19, 2004
    #4
  5. perry

    perry Guest

    I believe I found my answer, a whole different approach
    --
    Perry Leets
    Inovec Optimization and Control Systems
    Eugene, Oregon
    ----------------------------------------------------------------------------
    --------------------
    Sub testblock()
    Dim ObjAcad As Object
    Dim ObjDoc As Object
    Set ObjAcad = GetObject(, "AutoCAD.Application")
    Set ObjDoc = ObjAcad.ActiveDocument
    Dim Objblock As AcadBlock
    Dim varAttributeArray As Variant
    Dim Count As Integer
    Dim ACADObject As AcadEntity
    Dim Found As Boolean
    Dim CTab As Variant
    CTab = ObjDoc.GetVariable("ctab")

    For Each Objblock In ObjDoc.Blocks
    If Objblock.IsLayout = True Then
    If Objblock.Layout.Name = CTab Then
    For Count = 0 To Objblock.Count
    Set ACADObject = Objblock.Item(Count)
    If ACADObject.ObjectName = "AcDbBlockReference" Then
    If UCase(Left(ACADObject.Name, 6)) = "TITLE-" Then
    varAttributeArray = ACADObject.GetAttributes
    Found = True
    Exit For
    End If
    End If
    Next Count
    End If
    End If
    If Found Then Exit For
    Next Objblock
    End Sub
     
    perry, May 19, 2004
    #5
  6. perry

    perry Guest

    Oops, the above line should read:
    For Count = 0 To Objblock.Count - 1
     
    perry, May 19, 2004
    #6
  7. perry

    Jeff Mishler Guest

    Perry,
    You could replace the first three lines (For..If..If..) with this:
    Set ObjBlock = ThisDrawing.ActiveLayout.Block

    Could substantially reduce the run time by not looping through all the
    blocks until the one you need is found.

    Jeff
    from Elmira, OR but working in sunny CA this week.....;-)
     
    Jeff Mishler, May 19, 2004
    #7
  8. perry

    perry Guest

    An excellent tip Jeff !
    Nice to know there is another CADnut in my neck of the woods, maybe we
    should start our own "hole in the wall" user group ;)
    Perry
     
    perry, May 20, 2004
    #8
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.