How to get Drawing properties by AutoLISP

You know, we can add, set and customize some properties under "Drawing Properties" (File>Drawing Properties...).

Any Idea how to get those fields or properties value in AutoLisp?

Thank you in advance.

 

; From: Frank Whaley
; Revised by Allen Johnson
; Here is '(GetDwgProps)' and '(PutDwgProps)', which
; extracts Drawing Property data to a set of global
; variables (dp_Title, dp_Subject, etc.) and repack the
; data from the same set of variables.

; Read the DrawingProperties...
(defun GetDwgProps ( / xlist val )

(defun val ( dxfCode )
(cdr (assoc dxfCode xlist))
)
; Retrieve Xrecord
(setq xlist (dictsearch (namedobjdict) "DWGPROPS"))
(if xlist
; Extract values to variables
(setq dp_Title (val 2)
dp_Subject (val 3)
dp_Author (val 4)
dp_Comments (val 6)
dp_Keywords (val 7)
dp_LastSavedBy (val 8)
dp_RevisionNo (val 9)
dp_Cust0 (val 300)
dp_Cust1 (val 301)
dp_Cust2 (val 302)
dp_Cust3 (val 303)
dp_Cust4 (val 304)
dp_Cust5 (val 305)
dp_Cust6 (val 306)
dp_Cust7 (val 307)
dp_Cust8 (val 308)
dp_Cust9 (val 309)
)
)
xlist
)

;------------------------------------------------------------

; Write the DrawingProperties...
(defun PutDwgProps ( / xlist nonil)

(defun nonil (v) (if v v ""))

; Remove any existing Properties
(dictremove (namedobjdict) "DWGPROPS")

; Create data list
(setq xlist (list '(0 . "XRECORD")
'(100 . "AcDbXrecord")
'(1 . "DWGPROPS COOKIE")
(cons 2 (nonil dp_Title))
(cons 3 (nonil dp_Subject))
(cons 4 (nonil dp_Author))
(cons 6 (nonil dp_Comments))
(cons 7 (nonil dp_Keywords))
(cons 8 (nonil dp_LastSavedBy))
(cons 9 (nonil dp_RevisionNo))
(cons 300 (nonil dp_Cust0))
(cons 301 (nonil dp_Cust1))
(cons 302 (nonil dp_Cust2))
(cons 303 (nonil dp_Cust3))
(cons 304 (nonil dp_Cust4))
(cons 305 (nonil dp_Cust5))
(cons 306 (nonil dp_Cust6))
(cons 307 (nonil dp_Cust7))
(cons 308 (nonil dp_Cust8))
(cons 309 (nonil dp_Cust9))
(cons 40 (getvar "TDINDWG"))
(cons 41 (getvar "TDCREATE"))
(cons 42 ( getvar "TDUPDATE"))
)
)

; Make Xrecord and add to NOD
(dictadd (namedobjdict) "DWGPROPS" (entmakex xlist))
)

 

Thanks for respod.

I tried the codes to Retrieve the data. Did not work!

The 'xlist' is nil. Any suggestions?

 

That code only works up to AutoCAD 2002. Search this ng or the VBA one, as
solutions for 2004/2005 have been posted before.

--
R. Robert Bell


Thanks for respod.

I tried the codes to Retrieve the data. Did not work!

The 'xlist' is nil. Any suggestions?

 

Sorry, I hadn't used that since 2002 I guess....

 

This what I use...modify it for your use....records xrefs also.
Help from Robert Bell and Peter Jamtgaard.


Gary

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;; Architettura Copyright Settings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;; XData Copywrite Recording Functions
;;;;;;;;;;;;;;;;;;;;;;;
;;;loaded from ARCH_SUBROUTINES.fas file
(defun ARCH:XDATAINFO ()
(cond
((= (getvar "loginname") "cad_11")
(setq ARCH#XDPC "Drawn by: FWP")
)
((or
(= (getvar "loginname") "cad-41")
(= (getvar "loginname") "Gary Davidson Fowler")
)
(setq ARCH#XDPC "Drawn by: GDF")
)
((= ARCH#XDPC nil)
(setq ARCH#XDPC (strcat "Drawn by: " (getvar "loginname")))
)
)
(setq ARCH#XDCN "Company : ARCHITETTURA, Inc.")
(setq ARCH#XDAD "Address : Plano, Tx. 75075")
(setq ARCH#XDTP "Phone : 972.509.0088")
(setq ARCH#XDWW "Website : www.architettura-inc.com")
(setq ARCH#XDPR "Created using : Arch Program© for AutoCAD®")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;; Drawing Properties Recording Functions
;;;;;;;;;;;;;;;;;;;;;;
(defun ARCHutProps (/ xlist lognam datst crdate)
(cond
((= (getvar "loginname") "cad_11") (setq lognam "FWP"))
((or
(= (getvar "loginname") "cad-41")
(= (getvar "loginname") "Gary Davidson Fowler")
)
(setq lognam "GDF")
)
((= lognam nil) (setq lognam (getvar "loginname")))
)
(setq DATST (rtos (getvar "CDATE") 2 16)
CRDATE (substr DATST 1 4)
)
;; remove any existing Properties
(dictremove (namedobjdict) "DWGPROPS")
;; make data list
(setq xlist
(list
'(0 . "XRECORD")
'(100 . "AcDbXrecord")
'(1 . "DWGPROPS COOKIE")
(cons 2 (getvar "dwgprefix")) ;title
(cons 3
(strcat "File Name : "
(getvar "dwgname")
" [©"
CRDATE
"]"
)
)
;subject
(cons 4 "ARCHITETTURA, Inc. [www.architettura-inc.com]")
;author
(cons 6 Comments)
(cons 7 (ARCH:Basename (getvar "dwgname"))) ;keyword
(cons 8 lognam) ;LastSavedBy
(cons 9 RevisionNo)
(cons 300 Cust0)
(cons 301 Cust1)
(cons 302 Cust2)
(cons 303 Cust3)
(cons 304 Cust4)
(cons 305 Cust5)
(cons 306 Cust6)
(cons 307 Cust7)
(cons 308 Cust8)
(cons 309 Cust9)
(cons 40 (getvar "TDINDWG"))
(cons 41 (getvar "TDCREATE"))
(cons 42 (getvar "TDUPDATE"))
)
)
;; make Xrecord and add to NOD
(dictadd (namedobjdict) "DWGPROPS" (entmakex xlist))
(princ)
)
;;; From: Frank Whaley <>
;;; http://www.autodesk.com/support/filelib/acad14/acadficn.htm
;;; Here is '(getProps)' and '(putProps)', which
;;; extract Drawing Property data to a set of global
;;; variables (Title, Subject, etc.) and repack the
;;; data from the same set of variables.
(defun ARCH:GetProps (/ xlist val)
;; shorthand for extraction
(defun val (gc999)
(cdr (assoc gc999 xlist))
)
;; pick Xrecord from NOD
(setq xlist (dictsearch (namedobjdict) "DWGPROPS"))
;; extract values to variables
(setq Title (val 2)
Subject
(val 3)
Author (val 4)
Comments
(val 6)
Keywords
(val 7)
LastSavedBy
(val 8)
RevisionNo
(val 9)
Cust0 (val 300)
Cust1 (val 301)
Cust2 (val 302)
Cust3 (val 303)
Cust4 (val 304)
Cust5 (val 305)
Cust6 (val 306)
Cust7 (val 307)
Cust8 (val 308)
Cust9 (val 309)
)
xlist
)
;;;;;;;;;;;;;;;;;;;;;;;;;; Record Xref to Drawing Properties
;;;;;;;;;;;;;;;;;;;;;;;;
;;; --- get properties, grab refs, update properties
(defun XREFPROP-ORIGINAL ()
(setq chk (ARCH:GetProps))
(if (= chk nil)
(setq Title ""
Subject
""
Author ""
Comments
""
Keywords
""
LastSavedBy
""
RevisionNo
""
Cust0 ""
Cust1 ""
Cust2 ""
Cust3 ""
Cust4 ""
Cust5 ""
Cust6 ""
Cust7 ""
Cust8 ""
Cust9 ""
)
)
(setq lst (ARCH:XREF_LIST))
(cond
((= lst nil)
(progn
(setq str "Created using : Arch Program© for AutoCAD®")
(setq Comments str)
(ARCHutProps)
(princ "\n*** ----- Drawing Properties Updated ----- ***")
)
)
((/= lst nil)
(progn
(setq str "")
(foreach
itm
lst
(setq str (strcat str itm))
(if (/= itm (last lst))
(setq str (strcat str (chr 13) (chr 10)))
)
)
(if (<= (strlen str) 4096)
(progn
(setq Comments str)
(ARCHutProps)
(princ "\n*** ----- Drawing Properties Updated ----- ***")
)
)
)
;;(princ "\n* No Xref's Attached! *")
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;; Drawing Properties Recording Functions
;;;;;;;;;;;;;;;;;;;;;;
(defun ARCHutProps2004 (/ xlist lognam datst crdate dwginfo)
(cond
((= (getvar "loginname") "cad_11") (setq lognam "FWP"))
((or
(= (getvar "loginname") "cad-41")
(= (getvar "loginname") "Gary Davidson Fowler")
)
(setq lognam "GDF")
)
((= lognam nil) (setq lognam (getvar "loginname")))
)
(setq DATST (rtos (getvar "CDATE") 2 16)
CRDATE (substr DATST 1 4)
)
(setq dwginfo (vla-get-summaryinfo
(vla-get-activedocument (vlax-get-acad-object))
)
)
(vlax-put-property
dwginfo
'Author
"ARCHITETTURA, Inc. [www.architettura-inc.com]"
)
(vlax-put-property dwginfo 'Comments commentx)
(vlax-put-property
dwginfo
'Keywords
(ARCH:Basename (getvar "dwgname"))
)
(vlax-put-property
dwginfo
'Subject
(strcat "File Name : "
(getvar "dwgname")
" [©"
CRDATE
"]"
)
)
(vlax-put-property dwginfo 'Title (getvar "dwgprefix"))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;; Record Xref to Drawing Properties
;;;;;;;;;;;;;;;;;;;;;;;;
;;; --- get properties, grab refs, update properties
(defun XREFPROP-NEW (/ 1st commentx)
(setq lst (ARCH:XREF_LIST))
(cond
((= lst nil)
(progn
(setq str "Created using : Arch Program© for AutoCAD®")
(setq commentx str)
(ARCHutProps2004)
(princ "\n*** ----- Drawing Properties Updated ----- ***")
)
)
((/= lst nil)
(progn
(setq str "")
(foreach
itm
lst
(setq str (strcat str itm))
(if (/= itm (last lst))
(setq str (strcat str (chr 13) (chr 10)))
)
)
(if (<= (strlen str) 4096)
(progn
(setq commentx str)
(ARCHutProps2004)
(princ "\n*** ----- Drawing Properties Updated ----- ***")
)
)
)
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
(defun C:XREFPROP ()
(cond
((< (distof (substr (getvar "acadver") 1 4)) 16.0)
(XREFPROP-ORIGINAL)
)
((>= (distof (substr (getvar "acadver") 1 4)) 16.0)
(XREFPROP-NEW)
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;