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

Posted on 2009-02-16
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.
Question by:HelenG1240
  • 2
  • 2
LVL 10

Expert Comment

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

Author Comment

ID: 23655627
I am familiar with vb and lisp.
LVL 11

Assisted Solution

darrenmcwi earned 800 total points
ID: 23656691
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.
LVL 10

Accepted Solution

borgunit earned 1200 total points
ID: 23658504
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


Author Closing Comment

ID: 31547454
Thank you both. I am going to try both solutions to see which works the best for our needs.

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If, like me, you find yourself repeatedly and tediously joining many segments (lines, arcs) in other people's drawings back into polylines that can be used more effectively in Computer Aided Machining and Laser Cutting, then this article is for you!…
The following article will describe how to add/edit a dimension style through AutoCAD VBA. AutoCAD VBA has its quirks and when it comes to dimensions and controlling how they look through VBA.  This is where AutoCAD can be vividly confusing. The…
Integration Management Part 2
Enter Foreign and Special Characters Enter characters you can't find on a keyboard using its ASCII code ... and learn how to make a handy reference for yourself using Excel ~ Use these codes in any Windows application! ... whether it is a Micr…

621 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question