filter blocks

[Anonymous]

Hello guys,

I am lworking on a project that updates attributes. I have it working tcorrectly however I would like to modify a procedure so instead of filtering for 1 certain block, I would like it to search for another block if the first one is not found. I tried the if statement but it's not looking for the next block. I'm not at al familiar with filtering & group codes so I'm thinking maybe I'm missing some thing there. I currently have "Titleblock"
as the block to filter. If not found, I would like it to filter for TitlBlock2...and finally TitleBlock3. Could anyone point me in the right direction?

Code:
_____________________________

Private Sub UserForm_Initialize()



On Error Resume Next
ThisDrawing.SelectionSets("TBLK").Delete
Err.Clear

MultiPage1.Value = 0

Dim EntGrp(0) As Integer
Dim EntPrp(0) As Variant
Dim BlkObj As Object
Dim Pt1(0) As Double
Dim Pt2(0) As Double


'define error function
On Error GoTo Err_Control


'create a selection set
Set ssnew = ThisDrawing.SelectionSets.Add("TBLK")

'Filter for Group code 2, the block name
EntGrp(0) = 2


'The name of the block to filter for
'find the block

EntPrp(0) = "TitleBlock"
ssnew.Select acSelectionSetAll, Pt1, Pt2, EntGrp, EntPrp




'If a block is found
If ssnew.Count >= 1 Then

'Get the block's attributes
Tatts = ssnew.Item(0).GetAttributes

'display the attributes in the dialogue
formCop.TextBoxCntrNo1.Text = (LTrim(Tatts(0).TextString))
formCop.TextBoxContrName2.Text = (LTrim(Tatts(1).TextString))
formCop.TextBoxAddress3.Text = (LTrim(Tatts(2).TextString))
formCop.TextBoxAddress4.Text = (LTrim(Tatts(3).TextString))
formCop.TextBoxDrawnBy5.Text = (LTrim(Tatts(4).TextString))
formCop.TextBoxDate6.Text = (LTrim(Tatts(5).TextString))
formCop.TextBoxDwgTitle7.Text = (LTrim(Tatts(6).TextString))
formCop.TextBoxDwgNo8.Text = (LTrim(Tatts(7).TextString))
formCop.TextBoxType9.Text = (LTrim(Tatts(8).TextString))
formCop.TextBoxElevNo10.Text = (LTrim(Tatts(9).TextString))
formCop.TextBoxMachNo11.Text = (LTrim(Tatts(10).TextString))
formCop.TextBoxMainQty12.Text = (LTrim(Tatts(11).TextString))
formCop.TextBoxAuxQty13.Text = (LTrim(Tatts(12).TextString))
formCop.TextBoxRevNo14.Text = (LTrim(Tatts(13).TextString))
formCop.TextBoxRevDate15.Text = (LTrim(Tatts(14).TextString))
formCop.TextBoxRevInit16.Text = (LTrim(Tatts(15).TextString))
formCop.TextBoxRevDescr17.Text = (LTrim(Tatts(16).TextString))
formCop.TextBoxRevNo18.Text = (LTrim(Tatts(17).TextString))
formCop.TextBoxRevDate19.Text = (LTrim(Tatts(18).TextString))
formCop.TextBoxRevInit20.Text = (LTrim(Tatts(19).TextString))
formCop.TextBoxRevDescr21.Text = (LTrim(Tatts(20).TextString))
formCop.TextBoxRevNo22.Text = (LTrim(Tatts(21).TextString))
formCop.TextBoxRevDate23.Text = (LTrim(Tatts(22).TextString))
formCop.TextBoxRevInit24.Text = (LTrim(Tatts(23).TextString))
formCop.TextBoxRevDescr25.Text = (LTrim(Tatts(24).TextString))
formCop.TextBoxRevNo26.Text = (LTrim(Tatts(25).TextString))
formCop.TextBoxRevDate27.Text = (LTrim(Tatts(26).TextString))
formCop.TextBoxRevInit28.Text = (LTrim(Tatts(27).TextString))
formCop.TextBoxRevDescr29.Text = (LTrim(Tatts(28).TextString))


'turn to page 1
MultiPage1.Value = 0

'set the focus to TextBox1 and highlight the text
formCop.TextBoxCntrNo1.SetFocus
formCop.TextBoxCntrNo1.SelStart = 0
formCop.TextBoxCntrNo1.SelLength = Len(formCop.TextBoxCntrNo1.Text)

Else
'no attribute block, inform the user
MsgBox "No Title Block Attributes - Use Manual Edit..", vbCritical, "AfraLisp Title Block"

'delete the selection set
ThisDrawing.SelectionSets.Item("TBLK").Delete

End

End If

Exit Sub

Err_Control:

'disply error number and description
MsgBox Err.Number & " " & Err.Description

End


End Sub
_____________________________________________

[Anonymous]

If you have only a single instance of the title block in any given drawing,
the fix could be as simple as :

EntPrp(0) = "TitleBlock, TitleBlock1, TitleBlock2"

or even:

EntPrp(0) = "TitleBlock*"

The above would filter for any and all of the 3 names.

HTH,

Gary

[Anonymous]

Hi Gary,

I tried both suggestions but I get my msg box
"No Title Block Attributes - Use Manual Edit..", vbCritical, "AfraLisp Title Block". Any other suggestions I might try?

Thanks

Xi

[Anonymous]

The sample below should print the "Tagstring" and "Textstring" of the block
names you specified to the debug window.

I didn't have time to dissect your code. See how this sample compares to
what you have and your error should be evident.

Hope it helps.

Gary

Dim iDxfCode(0 To 1) As Integer
Dim vDxfData(0 To 1) As Variant
Dim vCurrAtts As Variant
Dim iAttCount As Integer
Dim oBlockSet As AcadSelectionSet
Dim oBlockRef As AcadBlockReference

On Error Resume Next
Set oBlockSet = ThisDrawing.SelectionSets("TempSet")
If Err Then
Err.Clear
Set oBlockSet = ThisDrawing.SelectionSets.Add("TempSet")
End If

oBlockSet.Clear
On Error GoTo 0

iDxfCode(0) = 0
vDxfData(0) = "INSERT"
iDxfCode(1) = 2
vDxfData(1) = "TitleBlock, TitleBlock2, TitleBlock3"
'vDxfData(1) = "TitleBlock*" 'Basically same as above


oBlockSet.Select acSelectionSetAll, , , iDxfCode, vDxfData

For Each oBlockRef In oBlockSet
If oBlockRef.HasAttributes Then
vCurrAtts = oBlockRef.GetAttributes
For iAttCount = LBound(vCurrAtts) To UBound(vCurrAtts)

Debug.Print vCurrAtts(iAttCount).TagString & vbTab &
vCurrAtts(iAttCount).TextString
'Load form text boxes here

Next iAttCount
End If
Next

[Anonymous]

Thanks Gary,

I was able to figure it out based on your sample code. My last step is to have a different message pop up dpending on which block is found.

I've declared the block as an acadblock and used the if statements but I still cannot firgure it out.

Any thoughts? I'm not familiar with the autocad portion of VBA.

Thanks,

[Anonymous]

wrote in message news:6033562@discussion.autodesk.com...
Thanks Gary,

I was able to figure it out based on your sample code. My last step is to
have a different message pop up dpending on which block is found.

I've declared the block as an acadblock and used the if statements but I
still cannot firgure it out.

it's a blockreference not a block definition
the reference has a .Name property

hth
mark

[Anonymous]

In addition to Mark's comments.

Have a look at "Select Case" in VBA help.

In the sample I posted you could use something like:

Select Case oBlockRef.Name

Case "TitleBlock"
MsgBox "Found TB1"

Case "TitleBlock2"
MsgBox "Found TB2"

Case "TitleBlock3"
MsgBox "Found TB3"

Case Else
MsgBox "Target TB not found"

End Select

[Anonymous]

Thanks Gary,

Works like a charm. Much appreciated.