Selection set exclusions

Discussion in 'AutoCAD' started by Tony Nichols, Dec 3, 2004.

  1. Tony Nichols

    Tony Nichols Guest

    Can anyone tell me if there is a DXF filter to use within VBA to exclude entities that are on a frozen layer?

    I am using the select method in order to find all the line entities within the drawing file to create a plotting window. But I have not determined a method to exclude those entities on frozen layers.

    I have pasted the code below I have written that finds all the "line" enties in the drawing file and sorts through them to find the upper and lower corner of the entities. Hopefully this will assist you in assisting me.

    Thanks,
    Tony Nichols

    AutoCAD 2002
    WinXP

    Public Sub WindowFind()
    Dim SS As Object
    Dim i As Integer, j As Integer
    Dim ep As Variant
    Dim sp As Variant
    Dim blkType As String
    Dim blkEntCnt As Integer
    Dim blkName As String
    Dim blks As AcadBlocks
    Dim TxtMsg As String
    Dim inspt As Variant
    Dim vAttrb As Variant
    Dim BlkRefObj As AcadBlockReference
    Dim lrgX As Double
    Dim smlX As Double
    Dim lrgY As Double
    Dim smlY As Double
    Dim bInitiate As Boolean

    Dim mode As Integer
    Dim groupcode(0) As Integer
    Dim datavalue(0) As Variant, datavalue2(0) As Variant
    Dim datavalue3(0) As Variant, datavalue4(0) As Variant
    Dim datavalue5(0) As Variant
    Dim dum As Variant ' Dummy variable

    RemoveSS
    Set SS = ThisDrawing.SelectionSets.Add("SS")
    Set blks = ThisDrawing.Blocks
    'SS.SelectOnScreen
    mode = acSelectionSetAll
    groupcode(0) = 0
    datavalue(0) = "LINE"
    datavalue2(0) = "INSERT"
    SS.Select mode, dum, dum, groupcode, datavalue
    SS.Select mode, dum, dum, groupcode, datavalue2

    'Check the insertion points of the block and set them as the initial
    'upper and lower corners of the plot window.
    For i = 0 To SS.Count - 1
    blkType = SS.Item(i).ObjectName
    If blkType = "AcDbBlockReference" Then
    inspt = SS.Item(i).InsertionPoint

    lrgX = inspt(0)
    smlX = inspt(0)
    smlY = inspt(1)
    lrgY = inspt(1)
    End If
    Next i

    For i = 0 To SS.Count - 1
    'MsgBox "Entity is " & SS.Item(i).ObjectName
    blkType = SS.Item(i).ObjectName

    Dim dScale As Double
    Dim dSP(0 To 2) As Double
    Dim dEP(0 To 2) As Double
    If blkType = "AcDbBlockReference" Then
    blkName = SS.Item(i).Name
    dScale = SS.Item(i).XScaleFactor
    inspt = SS.Item(i).InsertionPoint
    Set blkObj = blks.Item(blkName)
    Set BlkRefObj = SS.Item(i)
    For j = 0 To blkObj.Count - 1
    If blkObj.Item(j).ObjectName = "AcDbLine" Then
    sp = blkObj.Item(j).StartPoint
    ep = blkObj.Item(j).EndPoint
    'Make adjustments for Block scale and block insertion point
    dSP(0) = (sp(0) * dScale) + inspt(0)
    dSP(1) = (sp(1) * dScale) + inspt(1)
    dEP(0) = (ep(0) * dScale) + inspt(0)
    dEP(1) = (ep(1) * dScale) + inspt(1)
    sp = dSP
    ep = dEP
    'Find the smallest and largest X and Y values
    If sp(0) > lrgX Then
    lrgX = sp(0)
    End If
    If sp(0) < smlX Then
    smlX = sp(0)
    End If
    If ep(0) > lrgX Then
    lrgX = ep(0)
    End If
    If ep(0) < smlX Then
    smlX = ep(0)
    End If

    If sp(1) > lrgY Then
    lrgY = sp(1)
    End If
    If sp(1) < smlY Then
    smlY = sp(1)
    End If
    If ep(1) > lrgY Then
    lrgY = ep(1)
    End If
    If ep(1) < smlY Then
    smlY = ep(1)
    End If
    'MsgBox "Object is a BLOCK line with start point of " & sp(0) & "," & sp(1)
    End If
    Next j
    End If
    Set blkObj = Nothing
    Set BlkRefObj = Nothing

    If blkType = "AcDbLine" Then

    sp = SS.Item(i).StartPoint
    ep = SS.Item(i).EndPoint
    'Find the smallest and largest X and Y values
    If sp(0) > lrgX Then
    lrgX = sp(0)
    End If
    If sp(0) < smlX Then
    smlX = sp(0)
    End If
    If ep(0) > lrgX Then
    lrgX = ep(0)
    End If
    If ep(0) < smlX Then
    smlX = ep(0)
    End If

    If sp(1) > lrgY Then
    lrgY = sp(1)
    End If
    If sp(1) < smlY Then
    smlY = sp(1)
    End If
    If ep(1) > lrgY Then
    lrgY = ep(1)
    End If
    If ep(1) < smlY Then
    smlY = ep(1)
    End If
    'MsgBox "Object is a line with start point of " & sp(0) & "," & sp(1)
    End If
    Next i


    c1(0) = smlX
    c1(1) = smlY
    c1(2) = 0
    c2(0) = lrgX
    c2(1) = lrgY
    c2(2) = 0
    Dim Pnt1 As Variant
    Dim Pnt2 As Variant
    Pnt1 = c1
    Pnt2 = c2
    If Abs(lrgX - smlX) > Abs(lrgY - smlY) Then
    sDWGOrt = "Landscape"
    Else
    sDWGOrt = "Portrait"
    End If

    Call SSBox(Pnt1, Pnt2)

    MsgBox "Lower corner x: " & Str(smlX) & " y: " & Str(smlY) & vbCrLf & _
    "Upper corner x: " & Str(lrgX) & " y: " & Str(lrgY)
     
    Tony Nichols, Dec 3, 2004
    #1
  2. Hi,

    I would first get a list of all the non-frozen layers and put them into a
    comma separated string.

    You can then create a selection set of all object on those layers.

    --


    Laurie Comerford
    CADApps
    www.cadapps.com.au

    entities that are on a frozen layer?
    the drawing file to create a plotting window. But I have not determined a
    method to exclude those entities on frozen layers.
    enties in the drawing file and sorts through them to find the upper and
    lower corner of the entities. Hopefully this will assist you in assisting
    me.
     
    Laurie Comerford, Dec 4, 2004
    #2
  3. Tony Nichols

    Jeff Mishler Guest

    Something like this:
    Code:
    Sub SelectAllModelSpaceLinesOnThawedLayers()
    Dim lay As AcadLayer
    Dim strLayers As String
    Dim iCode(4) As Integer
    Dim vData(4) As Variant
    Dim ss As AcadSelectionSet
    
    Set ss = ThisDrawing.PickfirstSelectionSet
    
    For Each lay In ThisDrawing.Layers
    If lay.Freeze = True And Not lay.Name Like "*|*" Then
    If strLayers = "" Then
    strLayers = "" & lay.Name
    Else
    strLayers = strLayers & "," & lay.Name
    End If
    End If
    Next
    'Debug.Print strLayers
    iCode(0) = 0: vData(0) = "LINE"
    iCode(1) = 67: vData(1) = 0
    iCode(2) = -4: vData(2) = "<NOT"
    iCode(3) = 8: vData(3) = strLayers
    iCode(4) = -4: vData(4) = "NOT>"
    
    ss.Select acSelectionSetAll, , , iCode, vData
    Debug.Print ss.Count
    End Sub
    
     
    Jeff Mishler, Dec 4, 2004
    #3
  4. Tony Nichols

    Tony Nichols Guest

    Jeff,

    Thanks for your assistance. There is one statement in your code snippet that I am not following.

    Where you enumerate the layers can you tell me what the criteria of 'Not lay.Name Like "*|*"' is filtering out?

    Again thanks for the assitance.

    Tony
     
    Tony Nichols, Dec 6, 2004
    #4
  5. XREF Layers
     
    Nathan Taylor, Dec 6, 2004
    #5
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.