We help IT Professionals succeed at work.

Is it possible to extract the information in an AutoCad Attribute and insert it into Custom properties?

Medium Priority
Last Modified: 2013-12-04
Is it possible to use the attributes in the title block, (description, drawn by, material, etc.) to automatically fill in the AutoCad drawing custom properties?  If so, how? We are using AutoCad 2004.
Watch Question

Yes it is possible. What programming language are you familiar with?


I am familiar with vb and lisp.
How many attributes/properties?  The express tools contains a "PROPULATE" function that will populate custom property fields but it's limited to I think 10 fields because that's all that was allowed at one time (not sure which version of Autocad). Now AutoCAD handles more custom properties but the express tools propulate command won't do more than that.  You could hack that command or write your own fairly easily.

You should be able to do this in any of the AutoCAD API's...Lisp, VB, VBA, ARX, (VB.Net or C# in newer versions of AutoCAD).

I could likley hack something out fairly quickly if I know what block names to look for, the attribute tags, etc. Making something more "generic" that would be easily configured for anyone wanting to do this is a bit more work.

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts
These two snippets should get you started. The first gets a attribute to a text string and the second set some dwg properties. They are not customized for you but will get you going.
Public Sub MatchAttsByPicking()
'User selects attribute in block or text and then select attribute in block
'to match to
Dim acObj As Object
Dim vPickPt As Variant
Dim vMatrix As Variant
Dim vIDs As Variant
Dim sAtt As String
ThisDrawing.Utility.GetSubEntity acObj, vPickPt, vMatrix, vIDs, "Select Source Attribute"
Select Case acObj.ObjectName
Case "AcDbAttribute", "AcDbText"
Case Else
End Select
sAtt = acObj.TextString
Exit Sub
'If you click on space or do not select an entity, this error will be generated
If MsgBox("You have not selected an attribute.", vbOKCancel) = vbOK Then
    Resume TRY_AGAIN
End If
End Sub
Public Sub CustomDWGProps()
  Dim vNoMutt As Variant
  Dim i As Integer
  vNoMutt = ThisDrawing.GetVariable("NoMutt")
  ThisDrawing.SetVariable "NoMutt", 1
  AppActivate ThisDrawing.Application.Caption
  Dim acSumInfo As AcadSummaryInfo
  Set acSumInfo = ThisDrawing.SummaryInfo
  On Error Resume Next
  Dim strKWord As String
  ThisDrawing.Utility.InitializeUserInput 0, "Standard Custom ?"
  printMsg "DWG Properties [Standard/Custom/?]: "
  strKWord = ThisDrawing.Utility.GetKeyword() ''vbLf + "DWG Properties [Standard/Custom/?]: ")
  Dim strFieldName As String, strFieldValue As String, strFieldValueTest As String
  ''Test return value
  If strKWord = "Standard" Then
    ThisDrawing.Utility.InitializeUserInput 0, "Title Author Subject Hyperlinkbase Comments Keywords Lastsavedby Revisionnumber"
    printMsg "Standard DWG Properties [Title/Subject/Author/Keywords/Comments/Hyperlinkbase/Lastsavedby/Revisionnumber]: "
    strKWord = ThisDrawing.Utility.GetKeyword() ''vbLf + "Standard DWG Properties [Title/Subject/Author/Keywords/Comments/Hyperlinkbase/Lastsavedby/Revisionnumber]: ")
    If strKWord <> "" Then
      '' Get the Field Value from the user
      printMsg "Enter Field Value: "
      strFieldValue = ThisDrawing.Utility.GetString(True) '', vbLf + "Enter Field Value: ")
      If strFieldValue <> "" Then
        With acSumInfo
          Select Case strKWord
            Case "Title"
              .Title = strFieldValue
            Case "Author"
              .Author = strFieldValue
            Case "Subject"
              .Subject = strFieldValue
            Case "Hyperlinkbase"
              .HyperlinkBase = strFieldValue
            Case "Comments"
              .Comments = strFieldValue
            Case "Lastsavedby"
              .LastSavedBy = strFieldValue
            Case "Revisionnumber"
              .RevisionNumber = strFieldValue
          End Select
        End With
      End If
    End If
  ElseIf strKWord = "Custom" Then
    ThisDrawing.Utility.InitializeUserInput 0, "Add Modify Remove"
    printMsg "Custom DWG Properties [Add/Modify/Remove]: "
    strKWord = ThisDrawing.Utility.GetKeyword() ''vbLf + "Custom DWG Properties [Add/Modify/Remove]: ")
    '' Get the Field Name from the user
    printMsg "Enter Field Name: "
    strFieldName = ThisDrawing.Utility.GetString(True) '', vbLf + "Enter Field Name: ")
    '' It's easy enough to combine Add and Modify code into one function
    If strKWord = "Add" Or strKWord = "Modify" Then
      '' Get the Field Value from the user
      printMsg "Enter Field Value: "
      strFieldValue = ThisDrawing.Utility.GetString(True) '', vbLf + "Enter Field Value: ")
      '' Check to see if the Custom Property already exists
      acSumInfo.GetCustomByKey strFieldName, strFieldValueTest
      '' Check for Err and if Number is greater than 0 it doesn't exist yet
      If Err.Number <> 0 Then
        acSumInfo.AddCustomInfo strFieldName, strFieldValue
        acSumInfo.SetCustomByKey strFieldName, strFieldValue
      End If
    ElseIf strKWord = "Remove" Then '' Remove entry
      acSumInfo.RemoveCustomByKey strFieldName
    End If
  ElseIf strKWord = "?" Then
    '' Print title
    With acSumInfo
      printMsg vbLf + "Standard Properties "
      printMsg " Title: " + .Title
      '' Print Subject
      printMsg " Subject: " + .Subject
      '' Print Author
      printMsg " Author: " + .Author
      '' Print Keywords
      printMsg " Keywords: " + .Keywords
      '' Print Comments
      printMsg " Comments: " + .Comments
      '' Print Hyperlink Base
      printMsg " Hyperlink Base: " + .HyperlinkBase
      '' Print Last Saved By
      printMsg " Last Saved By: " + .LastSavedBy
      '' Print Revision Number
      printMsg " Revision Number: " + .RevisionNumber
      '' Get the number of Custom properties
      Dim nCustomProps As Integer
      nCustomProps = .NumCustomInfo
      Dim strKey As String, strValue As String
      '' Print Custom Properties if there are any
      If nCustomProps > 0 Then
        printMsg vbLf + "Custom Properties"
        For i = 0 To nCustomProps - 1
          .GetCustomByIndex i, strKey, strValue
          '' Print Custom Properties if there is any
          printMsg " " + strKey + ": " + strValue
        Next i
        printMsg vbLf
        '' No Custom Properties exist
        printMsg vbLf + "No Custom Properties" + vbLf
      End If
    End With
  End If
  ThisDrawing.SetVariable "NoMutt", vNoMutt
  Set acSumInfo = Nothing
End Sub

Open in new window


Thank you both. I am going to try both solutions to see which works the best for our needs.
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.


Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.