Autodesk User Group International

Welcome back to part three of our Auto Tagging routine. I trust that all of you have stepped through the code shown to see how it was working during the last month. If there aren�t any questions then I shall proceed to working with the user forms and making this example more robust and user friendly. All set then? Good! Let�s proceed with some new code.

As I mentioned earlier, it would be nice to allow our user to set a door tag style and not be prompted again. We can do this with XRecords, but first things first. Let�s begin at the beginning and add some public variables to our project. Double click on your �DoorTagger� object in the project explorer window and add the following line of code shown in bold typeface in the General Declarations area of the code window (watch for word wrapping in the code shown in this article).



Option Explicit
Public o_DoorObj As AecDoor
Public dic_Doors As Scripting.Dictionary
Public dic_MVBlocks As Scripting.Dictionary
Public blnRunning As Boolean
Public strDoorTagName As String
'store the door tag style name for future re-use
'We are hardcoding this today, but we could get 
'the value of "roamablerootprefix"
'and then perform some swapping of values to make this more modular
Const str_TagSource As String = "C:\Documents and Settings\All Users\Application Data\Autodesk\ADT 2006\enu\Styles\Imperial\Schedule Tables (Imperial).dwg"
Const str_TagName As String = "Aec6_Door_Tag_Project_Scale_Dependent" '"Aec6_Door_Tag"
Const str_PropSet As String = "DoorObjects"
Const strPropSource As String = "C:\Documents and Settings\All Users\Application Data\Autodesk\ADT 2006\enu\Styles\Imperial\Schedule Tables (Imperial).dwg"

The code above includes two new variables and some inline commenting:

A Boolean (true/false) variable for tracking whether our routine is currently running or simply loaded in the editor.
A string variable to hold the value of our default tag. If we don�t set the default or it doesn�t exist in our custom XRecord (more on that later), then the value will simply be empty. You�ll see where this comes into play.
For the adventurous, I�ve added some comment to help you make this routine even more portable�rather than hardcoding the path to the drawing containing our door tags, you could grab a built-in variable named roamablerootprefix and perform some string surgery to save the path. This might allow you to create a default path and then provide a means for users to search for their own custom style drawing. It is all up to you!

Let�s take this time to revisit our Forms at this time. I hope you have named yours as I have named mine. If not, then it will be up to you to find the form names in the code and change my example code to match your names. If you want to rename your form objects at this time, I�ll wait for you!

UserForm1 is named frm_ChooseTag and UserForm2 is named frm_Query

Everyone back? Good, let's proceed. Take a look at the Forms shown below and add the controls and code listed below each form:

frm ChoosTag (formerly known as UserForm1) Recipe:
3 Image Controls (Visit the Forum to download the bitmaps for the Tags!)
3 OptionButtons
              OptionButton1
                            Caption: Door Tag
              OptionButton2
                            Caption Door Tag � Project Based & Scale Dep
              OptionButton4
                            Caption Door Tag � Project Based
1 CommandButton
              Caption: �OK�

The Code behind this form:


Option Explicit

Private Sub CommandButton1_Click()
    If OptionButton1.Value = True Then
        strDoorTagName = "AEC6_Door_Tag"
    ElseIf OptionButton2.Value = True Then
        strDoorTagName = "Aec6_Door_Tag_Project_Scale_Dependent"
    ElseIf OptionButton4.Value = True Then
        strDoorTagName = "Aec6_Door_Tag_Project"
    End If
    DoorAutoTAG_Set strDoorTagName
    frm_ChooseTag.Hide
End Sub

Well, well, those of you who are paying attention noticed that I slipped in a new function call in that code. Did you see it? It is the call where I am passing in the value of my new public string variable (strDoorTagName). We�ll come back to that function later.

Here is the other UserForm.

Frm_Query (formerly known as UserForm2) Recipe:
2 Command Button Controls
              CommandButton1
                            Caption: Yes
              CommandButton2
                            Caption: No
1 Label
              Caption: �No default Door Tag found. Would you like to automatically tag all doors upon insertion?�

The Code behind this form:


Option Explicit

Private Sub Cmd_No_Click()
    blnRunning = False
    Unload Me
End Sub

Private Sub cmd_Yes_Click()
    frm_ChooseTag.Show
End Sub

It is really quite simple, isn�t it? Except for that bit of trickery! Did you notice that I renamed those command buttons in the code example? Be sure to name yours as well! These two forms are shown during different parts of the program. The frm_Query form should be shown to the user the first time the VBA Project is loaded if our custom XRecord is not found in the drawing. Of course, we are still not ready to launch into the whole XRecord thing yet, but bear with me and we�ll get to it soon enough. When this (Query) form is displayed, the user can make a choice:

Click Yes. This will launch the first form allowing the user to choose a tag type.
Click No and unload the macros so it is no longer running. This is also where we set the Boolean value to indicate that the door tagging should not occur.

With those Form updates included it is time to revisit our �ThisDrawing� object for some additional code insertion. Please activate the code window and add the bold code shown below in the �GoGoDoorTagger� subroutine (watch for word wrapping in the code shown in this article).


Public Sub GoGoDoorTagger()
'----------------------------------------------------------------------
' Sub : GoGoDoorTagger
' DateTime  : 12/1/2005 17:49
' Author    : Richard L Binning
' Purpose   :
'----------------------------------------------------------------------
'
   On Error GoTo GoGoDoorTagger_Error
    blnRunning = True
    DoorTagger.InitDoorTools

   On Error GoTo 0
   Exit Sub

GoGoDoorTagger_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & _
           ") in procedure GoGoDoorTagger of VBA Document ThisDrawing"
End Sub

Since this routine gets called first when we want to turn on our AutoTagging routine, it makes sense to set our Boolean variable here. If we never call this routine, then there is no way for our Boolean to get set to True. Once its value is set true, we call our InitDoorTools sub contained in the DoorTagger module. Let�s head on over to that object and update some more code now.

The InitDoorTools routine initializes the two Scripting Dictionaries for use and sets aside the memory required for them. Please switch to the DoorTagger module and add the code shown in bold below:


Public Function InitDoorTools() As Boolean
'----------------------------------------------------------------------
' Function : InitDoorTools
' DateTime  : 12/8/2005 17:54
' Author    : Richard L Binning
' Purpose   :
'----------------------------------------------------------------------
'
   On Error GoTo InitDoorTools_Error

Set dic_Doors = New Scripting.Dictionary
Set dic_MVBlocks = New Scripting.Dictionary
strDoorTagName = DoorAutoTAG_Get
If Len(strDoorTagName) < 2 Then
    frm_Query.Show
End If
   On Error GoTo 0
   Exit Function

InitDoorTools_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & _
           ") in procedure InitDoorTools of Module DoorTagger"
End Function

A little dab�ll do ya, as my barber used to say, and it couldn�t be truer than shown above. Just a little bit of code is really going to make our routine user friendly. The code above makes a call to a new function �DoorAutoTAG_Get� and retrieves our default tag name value if set. If the value is not yet set, then our frm_Query is shown prompting the user to tag all or tag none.

I guess that means that it is time to explore our XRecord contraption. I told you we would get around to it! If you�re ready, we�ll begin with the definition of an XRecord and then see one situation where they can be used to great effect.

An XRecord is an object that is saved with the drawing. It is also directly accessible by other ObjectARX, VBA, and LISP programs. XRecord objects are used to store and manage arbitrary data such a unique name and an associate string to be set and retrieved by the two functions listed below. (Please add the following code to your DoorTagger module now and as always watch for word wrapping which may be present in this article but should not be present in your code window!):


Function DoorAutoTAG_Set(ByVal strDoorTagName As String) As Boolean
    If strDoorTagName <> "" Then
        Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord
        Dim XRecordDataType As Variant, XRecordData As Variant
        Dim ArraySize
        Dim iCount As Long
        Dim DataType As Integer, Data As String, msg As String
        
        ' Unique identifiers to distinguish this XRecordData from other XRecordData
        Const TYPE_STRING = 1
        Const TAG_DICTIONARY_NAME = "BinningsDoorAutoTag"
        Const TAG_XRECORD_NAME = "BinningsDoorAutoTagXRecord"
    
        ' Connect to the dictionary in which to store the XRecord
        On Error GoTo CREATE
        Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME)
        Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME)
        On Error GoTo 0
        
        ' Get current XRecordData
        TrackingXRecord.GetXRecordData XRecordDataType, XRecordData
                
        '    ' If there is no array yet then create one
        If VarType(XRecordDataType) And vbArray = vbArray Then
            ArraySize = UBound(XRecordDataType) + 1       ' Get the size of the data elements returned
            ArraySize = ArraySize + 1                        ' Increase to hold new data
    
            ReDim Preserve XRecordDataType(0 To ArraySize)
            ReDim Preserve XRecordData(0 To ArraySize)
        Else
            ArraySize = 0
            ReDim XRecordDataType(0 To ArraySize) As Integer
            ReDim XRecordData(0 To ArraySize) As Variant
        End If
                
        ' Add new XRecord Data
        XRecordDataType(0) = TYPE_STRING: XRecordData(0) = CStr(strDoorTagName)
        TrackingXRecord.SetXRecordData XRecordDataType, XRecordData
        DoorAutoTAG_Set = True
    Else
        DoorAutoTAG_Set = False
    End If
    Exit Function
    
CREATE:
    ' Create the objects that hold this XRecordData
    If TrackingDictionary Is Nothing Then  ' Make sure to have tracking object
        Set TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME)
        Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_NAME)
    End If
    
    Resume
End Function

Function DoorAutoTAG_Get() As String
    Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord
    Dim XRecordDataType As Variant, XRecordData As Variant
    Dim ArraySize As Long, iCount As Long
    Dim DataType As Integer, Data As String, msg As String
    
    ' Unique identifiers to distinguish this XRecordData from other XRecordData
    Const TYPE_STRING = 1
    Const TAG_DICTIONARY_NAME = "BinningsDoorAutoTag"
    Const TAG_XRECORD_NAME = "BinningsDoorAutoTagXRecord"

    ' Connect to the dictionary in which to store the XRecord
    On Error GoTo FAIL
    Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME)
    Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME)
    On Error GoTo 0
    
    ' Read back all XRecordData entries
    TrackingXRecord.GetXRecordData XRecordDataType, XRecordData

    ' Get information for this element
    DataType = XRecordDataType(0)
    Data = XRecordData(0)

    DoorAutoTAG_Get = CStr(Data)

    Exit Function
    
FAIL:

DoorAutoTAG_Get = ""
End Function

You�ll notice some similarities in the code shown above. The code for the Set value routine (DoorAutoTAG_Set) accepts a string value containing the name of the tag to be recorded and then proceeds to:

create the record if it doesn�t exist
and then populate the new XRecord with two string values.

The result of running the Set value routine returns either a True or False condition upon exit.

The retrieval code (DoorAutoTAG_Get) simply checks for the expected XRecord and, if not found, it errors out gracefully returning an empty string. If it finds it, then it returns the tag name to be used in other code functions or subs.

Now we are getting down to the end of this project. Lets revisit our AEC_Anchor_TagToEnt function and add more code to make our project truly user friendly and robust. Look for the bold lines shown below and add them to your macro in the code window:

From DoorTagger.mod:



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''      AecAnchorTagToEnt as Modified by RLB
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function AEC_Anchor_TagToEnt(objACEnt As AcadEntity) As Boolean
    On Error Resume Next
    
    'Declaration
    Dim adtDoc As AecArchBaseDocument
    Dim mvBlkRef As AecMVBlockRef
    Dim ent As AcadEntity
    Dim pt As Variant
    Dim door As AecDoor
    Dim anchor As New AecAnchorTagToEnt
    
    'Initialization of AecArchBaseDocument
    Set adtDoc = AecArchBaseApplication.ActiveDocument
    
    If objACEnt Is Nothing Then
      adtDoc.Utility.Prompt "Nothing Provided - tag will not be anchored." & vbCrLf
      GoTo ExitTag:
    ElseIf Not (TypeOf objACEnt Is AecDoor) Then
      adtDoc.Utility.Prompt "Not a Door - tag will not be anchored." & vbCrLf
      GoTo ExitTag:
    End If
    
    'Select a point to locate the tag
    Set ent = objACEnt
    pt = rtnTagCenterPoint(ent)
    If Err.Number <> 0 Then
        adtDoc.Utility.Prompt "Error when getting a point." & vbCrLf
        GoTo ExitTag
    End If
    'Get Current Layer
    Dim strRestorLay As String
    strRestorLay = Get_ActiveLayer
    If Not (strRestorLay Like "A-DOOR-IDEN") Then
        Dim strLKName As String
        'Set correct layer by getting layer key
        strLKName = AEC_GenerateLayer("DOORNO")
        'Set Current Layer to correct layer
        ThisDrawing.ActiveLayer = ThisDrawing.Layers(strLKName)
    End If
    
    'Insert an MVBlockRef using a hardcoded door tag style and
    'at the specified location
    Set mvBlkRef = adtDoc.ModelSpace.AddCustomObject("AecMVBlockRef")
    mvBlkRef.Location = pt
    'get correct scale for tag by reading database scale
    'Get Current Database Scale
    'Dim intDBScale As Integer
    'intDBScale = (Get_DatabaseScale / 12)
    'mvBlkRef.ScaleX = intDBScale: mvBlkRef.ScaleY = intDBScale: mvBlkRef.ScaleZ = intDBScale
    'The above code is remarked out while using scale dependent tags

    'If the public variable strDoorTagName is filled, then
    'our XRecord value was retrieved and a default exists
    If Len(strDoorTagName) < 2 Then
        mvBlkRef.StyleName = str_TagName
    Else
        'force the stylename using our pre-defined contstant
        mvBlkRef.StyleName = strDoorTagName
    End If

    If Err.Number <> 0 Then
        'add dbximport for door tag style here since error indicates
        'that the tag style was not present in the current drawing
        ImportMVBlockStyle str_TagName, str_TagSource
        mvBlkRef.StyleName = str_TagName
        GoTo ExitTag
    End If
    
    'Anchor the tag to the door
    Set door = ent
    anchor.Reference = door
    mvBlkRef.AttachAnchor anchor
    
    
ExitTag:
    'restore the previous layer
    ThisDrawing.ActiveLayer = ThisDrawing.Layers(strRestorLay)
    Set adtDoc = Nothing
    Set mvBlkRef = Nothing
    Set ent = Nothing
    Set door = Nothing
    Set anchor = Nothing
     
End Function

See that? Most of our work was already accomplished in the previous months. Isn�t it amazing how little extra code is needed to truly make this routine polished and user friendly? The only thing missing from our routine is a subroutine to allow users to change their minds. Since we are making this function work like Ron Popeil�s rotisserie (�Set it and forget it!�), we will need a routine to change the default. You can add the following subroutine to the Doortagger module so that, at any time, users can change their minds, launch the tag chooser user form, and select a different door tag as the default. Please add the following code now:


Public Sub ChangeTagDefault()
Dim strDefTag As String
strDefTag = DoorAutoTAG_Get

Select Case strDefTag

    Case "AEC6_Door_Tag"
        frm_ChooseTag.OptionButton1.Value = 1
        frm_ChooseTag.OptionButton1.SetFocus
    Case "Aec6_Door_Tag_Project_Scale_Dependent"
        frm_ChooseTag.OptionButton2.Value = 1
        frm_ChooseTag.OptionButton2.SetFocus
    Case "Aec6_Door_Tag_Project"
        frm_ChooseTag.OptionButton4.Value = 1
        frm_ChooseTag.OptionButton4.SetFocus

End Select
frm_ChooseTag.Caption = "Select New Tag"
frm_ChooseTag.Show
End Sub

Did you see anything we missed? You should add some error trapping to the above routine. Hint: Case Else. Let�s return at this time to our �ThisDrawing� object and add a short bit of code to our event handler for new objects. After all, we want to be able to ignore the routine if our user chose the �No� option on one of our handy-dandy forms, right? Add the bold text to your code window.


Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
   On Error GoTo AcadDocument_EndCommand_Error

    Debug.Print "Acad Doc End Command ... " & CommandName
    Select Case CommandName
        Case "AECDOORADDSELECTED", "AECDOORADD", "DROPGEOM", "COPY", "PASTECLIP"
            If Not o_DoorObj Is Nothing Then
                GoTo AcadDocument_EndCommand_TagDoor
            Else
                GoTo AcadDocument_EndCommand_CleanExit
            End If
        Case Else
            GoTo AcadDocument_EndCommand_CleanExit
    End Select
    

AcadDocument_EndCommand_TagDoor:
    Debug.Print "AcadDocument Ready to Tag"
    ' "AcadDocument Ready to Tag It!"
    'If DoorTagger.AddDoor(o_DoorObj) Then
    '    Debug.Print "Success"
    'End If
    If blnRunning Then
        Set o_DoorObj = Nothing
        Call ProcessDoors
    End If
    
AcadDocument_EndCommand_CleanExit:
   'add hook removal procedure here
   On Error GoTo 0
   Exit Sub

AcadDocument_EndCommand_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure AcadDocument_EndCommand of VBA Document ThisDrawing"
End Sub

Look at that! A simple If...then conditional to make our code perform or slack off, based on our user's whim! And as Porky Pig says, "That�s all folks!" Of course, our entire routine requires that our user not hit the �Escape� key during insertion of doors. I know that will be awful hard for some of you. We will revisit this code in a later issue and add some �hook� code to capture that key press and exit gracefully. As always, go to the AUGI forum associated with this article to ask questions and get the code without typing. I�ll post the graphics used in the forms for your use, too! See you on the forums!

(Discuss this Article! in AUGI's Discussion Forums.)

Submitted by Richard Binning, Vice-President, Local User Group Manager, and Forums Manager for AUGI Board of Directors. Richard is a member of the AEC/IS Roundtable and author of Beside The Cursor, a CAD/BIM/Technology related blog. Richard currently works as Manager, AE Technology Application, for The Haskell Company and is a Certified Autodesk Instructor for the Technology Institute of the South, a Premiere Autodesk Training Center.