Field Code Macro

[Anonymous]

I want to contribute the following lisp code which retrieves the filed code from a text or attribute. I know we have FieldCode method in VBA for texts for this purpose but there is no equivalent for attributes. This code works for both and save the output to USERS1 variable so it can be used in a VBA macro. You can also use "fldtxt" variable in other AutoLisp codes.There is also a sample AutoLISP function "TFC" and VBA macros to utilize the GetFieldCode function in VBA. I am a newbie in AutoLISP programming so you may find the code not very efficient. I appreciate any comment.

;Start of AutoLISP code:

(defun GetFieldCode (handle / tmp fld fldCounter subFldTxt fldNo fldList)
(setq tmp (entget (handent handle))) ; get the entity
(princ "\n")
(setq fld
(entget
(cdr
(assoc
'360
(entget (cdr (assoc '360 (entget (cdr (assoc '360 tmp)))))
; get the field object
)
)
)
)
)

(setq fldtxt (cdr (assoc '2 fld))) ; get the field pattern string
(setq fldCounter 0)
(setq fldNo (cdr (assoc '90 fld))) ; number of fields
(setq fldList (vl-remove-if 'null (mapcar '(lambda (a) (if (= (car a) 360) a)) fld))) ; filter list of field entities
(while (< fldCounter fldNo) ; loop to the number of fields
(setq tmp (strcat "\\_FldIdx " (itoa fldCounter)))
; part of the field string to be replaced
(setq subFldTxt
(cdr (assoc '2 (entget (cdr (nth fldCounter fldList)))))
) ; get the actual field string for each sub field
(setq fldtxt (vl-string-subst subFldTxt tmp fldtxt))
; and replace it in the text string
(setq fldCounter (1+ fldCounter))
)

(setvar "USERS1" fldtxt) ; save the output field code to USERS1 system variable
(princ)
)

(defun C:TFC() ; Test GetFieldCode function
(setq hnd (cdr (assoc '5 (entget (car (nentsel)))))) ; gettign the entity handle
(GetFieldCode hnd)
(princ fldtxt)
(princ)
)

;Endt of AutoLISP code:

;Start of VBA macros

Private Function GetFieldCode(ByVal objHandle As String) As String
On Error GoTo ErrorHandler
Dim cmd As String
ThisDrawing.SetVariable "CMDECHO", 0
cmd = "(GetFieldCode """ & objHandle & """) "
ThisDrawing.SendCommand cmd
GetFieldCode = ThisDrawing.GetVariable("USERS1")
ErrorHandler:
If Err Then
Debug.Print "GetFieldCode: " & Err.Description
GetFieldCode = ""
Err.Clear
End If
ThisDrawing.SetVariable "CMDECHO", 1
End Function

Sub testGetFieldCode()
On Error GoTo ErrorHandler
Dim Object As AcadObject
Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData
Debug.Print Object.TextString
Debug.Print GetFieldCode(Object.handle)
ErrorHandler:
If Err Then
Debug.Print Err.Description
End If
End Sub

;End of VBA macros

[Anonymous]

Updated Macro to Get the Field Code from Texts, MTexts and also ATTRIBUTES (not available by Autodesk).
Thanks to tlindal for the get ObjectId part of the code.
The problem with original code was it didn't work for nested fields like fields with formulas.
You can use the same technique as the original code to use the Lisp Macro in VBA.

;;;Code starts here

;; GetFieldCode Fuction
;; By: Hossein Najmi
;; Date: Jul 2005
;; last updated: Dec 2005
;; Changed to retrive all children field codes

(defun C:f2t
(/ ent fldObj)
;; get the entity
(setq ent (entget (car (nentsel))))
(princ "\n")
;; get the parent field object
(if (/= (assoc '360 ent) nil)
(progn
(setq fldObj
(entget
(cdr
(assoc
'360
(entget (cdr (assoc '360
(entget (cdr (assoc '360 ent)))
)
)
)
)
)
)

)
;; run GetFieldCode function to iterate through all field children
;; and retrieve the field code using recursion technique
(setq fldtxt (GetFieldCode fldObj))

(princ fldtxt)
)
)
(princ)
)

;; function to get the field code from a FIELD object and
;; from all the children it may have
(defun GetFieldCode (fldObj / tmp fldtxt
fldCounter subFldTxt fldNo subFldObj
fldList
)
;; get the field pattern string
(setq fldtxt (cdr (assoc '2 fldObj)))

(setq fldCounter 0)
;; number of fields
(setq fldNo (cdr (assoc '90 fldObj)))
;; filter the list of field entities
(setq fldList (vl-remove-if
'null
(mapcar '(lambda (a)
(if (= (car a) 360)
a
)
)
fldObj
)
)
)

;; loop to the number of fields
(while (< fldCounter fldNo)
;; part of the field string to be replaced
(setq tmp (strcat "\\_FldIdx " (itoa fldCounter)))
(setq subFldObj (entget (cdr (nth fldCounter fldList))))
;; get the actual field string for each sub field
(setq subFldTxt (if (= 0 (cdr (assoc '90 subFldObj)))
(cdr (assoc '2 subFldObj))
(GetFieldCode subFldObj)
)
)

;; get the ObjectId if there is any refernce to an Object
(if (/= (assoc '331 (entget (cdr (nth fldCounter fldList))))
nil
)
(progn
(setq subFldOid
(strcat
"ObjId "
(itoa
(vla-get-ObjectID
(vlax-ename->vla-object
(cdr
(assoc
'331
(entget (cdr (nth fldCounter fldList)))
)
)
)
)
)
)
)
;; insert the ObjectId in the code
(setq
subFldTxt (vl-string-subst subFldOid "ObjIdx 0" subFldTxt)
)
)
)
;; replace subfield code in the text string
(setq fldtxt (vl-string-subst subFldTxt tmp fldtxt))
(setq fldCounter (1+ fldCounter))
)
(setq output fldtxt)
)

;;; Code ends here

[Anonymous]

Do you know of any way that you could get the ObjId value from an entity (say using its HANDLE). What I would like to do is:

1. Room Tag block with Area attribute.
2. Step though drawing for each RoomTag without area
3. Ask user to select closed entity to define field linking to area
4. Define value of Area attribute to Area of selected entity containing a field code something like this:
   %<\AcObjProp.16.2 Object(%<\_ObjId 2122381568>%).Area \f
"%lu6%pr2%ct8[1e-006]">%m²

My question is how do I get that Id number for the object. It must be a non visual element, but does each object already have such Id or should it be created? If so how? Message was edited by: irneb

[Anonymous]

This may help you get started

http://rkmcswain.blogspot.com/2006/09/create-field-linked-to-object.html

[Anonymous]

Will give it a try thanks.