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)
Reply With Quote
