AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Attributes and VBA

You can find the AutoLisp equivalent to this application here.

When you want to edit attributes in AutoCAD most of us use the "Attedit" command. Firstly, we must select the attribute we would like to edit. Then the "Edit Attribute" dialogue box appears which allows us to add or change the values of our attribute. Personally, I think this dialogue leaves a lot to be desired. You cannot customise it in any way, and it displays all attributes whether you want them or not. As well, if you have a lot of attributes you need to page your way through numerous dialogues before reaching the attribute you want to edit.

In this tutorial we are going to have a look at extracting attribute data from a block, displaying the data in a custom dialogue box, and then updating the attribute data on exit.
Right, what do we need to do?

  • Find the block containing the attribute data. (Why select it when we can get AutoCAD to find it for us.)
  • Extract the attribute data and display it in a dialogue box.
  • Allow the user to change the data if he so wishes.
  • Update the attribute data with the new information entered into the dialogue box.

O.K. fire up AutoCAD and open the drawing Attab.dwg.

Alright, I admit that it's not much of a title block, but it's enough to give you the general idea.

Load run run the macro.

This dialogue should appear :

Change some of the data and then press the "OK" button.
The title block data should be updated. Clever hey?

You can expand on this routine as much as you like using the following coding as a template.
Hint : You don't have to display all the attribute data stored in a block. Only display what you want the user to modify. As well, you can split your data over multiple dialogue boxes. eg. One for title block, one for revisions, one for reference drawings, etc. All the data though is contained in one attribute.

Here's the coding :

'CODING STARTS HERE

'All Tutorials and Code are provided "as-is" for purposes of instruction and
'utility and may be used by anyone for any purpose entirely at their own risk.
'Please respect the intellectual rights of others.
'All material provided here is unsupported and without warranty of any kind.
'No responsibility will be taken for any direct or indirect consequences
'resulting from or associated with the use of these Tutorials or Code.
'*******************************************************************************
'           AfraLisp
'       http://www.afralisp.com
'        afralisp@afralisp.com
'        afralisp@mweb.com.na
'*******************************************************************************
'This application will extract attributes from a block and display them in a
'dialog box. The attributes will then be updated.

Option Explicit

Public Tatts As Variant
Public ssnew As Object

Private Sub CommandButton1_Click()
    
    'Update the attribute values
    UpdateAttrib 0, UserForm1.TextBox1.Text
    UpdateAttrib 1, UserForm1.TextBox2.Text
    UpdateAttrib 2, UserForm1.TextBox3.Text
    UpdateAttrib 3, UserForm1.TextBox4.Text
    UpdateAttrib 4, UserForm1.TextBox5.Text
    
    'update the block
    ssnew.Item(0).Update
    
    'delete the selection set
    ThisDrawing.SelectionSets.Item("TBLK").Delete
   
    End
    
End Sub

Private Sub CommandButton2_Click()

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

End

End Sub

Private Sub UserForm_Initialize()

  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
    EntPrp(0) = "attab-info"
    
    'find the block
    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
        UserForm1.TextBox1.Text = (LTrim(Tatts(0).TextString))
        UserForm1.TextBox2.Text = (LTrim(Tatts(1).TextString))
        UserForm1.TextBox3.Text = (LTrim(Tatts(2).TextString))
        UserForm1.TextBox4.Text = (LTrim(Tatts(3).TextString))
        UserForm1.TextBox5.Text = (LTrim(Tatts(4).TextString))
    
        'set the focus to TextBox1 and highlight the text
        UserForm1.TextBox1.SetFocus
        UserForm1.TextBox1.SelStart = 0
        UserForm1.TextBox1.SelLength = Len(UserForm1.TextBox1.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:

        'display error number and description
        MsgBox Err.Number & " " & Err.Description
        
        End
    
End Sub
Sub UpdateAttrib(TagNumber As Integer, BTextString As String)
  
  'This procedure checks to see if the text box has a value.
  'If it does, it applies the text to the attribute.
  'If not, it applies an empty string to the attribute.
  If BTextString = "" Then
  
        Tatts(TagNumber).TextString = ""
    
  Else
   
        Tatts(TagNumber).TextString = BTextString
    
  End If
  
End Sub

'CODING ENDS HERE

OK, I know you can't type. Here's the coding.

 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website