CADForums.net

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)

Allen Johnson · Guest

You might try something like:

If ThisDrawing.Layers(SS.Item(i).Layer).Freeze = False then
......

Laurie Comerford · Guest

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

"Tony Nichols" <nospam@address.withheld> wrote in message
news:32715058.1102112761534.JavaMail.jive@jiveforum2.autodesk.com...

Jeff Mishler · Guest

Something like this:

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 · Guest

Allen thanks for the tip. I was able to add two lines of code and corrected the problem.

Discussion groups are wonderful!

Thanks again.
Tony

Nathan Taylor · Guest

XREF Layers

	CADForums.net Forum Index -> VBA	All times are GMT
Page 1 of 1