help : dwgprop lisp fix

[Anonymous]

gary fowler

can you fix to work in autocad
i cant make it work right

;;;;;;;;;;;;;;;;;;;;;;; Drawing Properties Recording Functions
;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:PutProps (/ xlist lognam datst crdate)
(cond ((= (getvar "loginname") "cad_11") (setq lognam "FWP"))
((or (= (getvar "loginname") "CAD_5")
(= (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)
(ARCH:GetCustomInfo)
;; 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 😎
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)
(ARCH:PutProps)
(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)
(ARCH:PutProps)
(princ "\n*** ----- Drawing Properties
Updated ----- ***"))))
;;(princ "\n* No Xref's Attached! *")
))
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;; Drawing Properties Recording Functions
;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:PutProps2004 (/ xlist lognam datst crdate dwginfo)
;;(ARCH:PutCustomInfo "Test 1" "#1" 1)
;;(ARCH:PutCustomInfo "Test 2" "#2" 2)
(cond ((= (getvar "loginname") "cad_11") (setq lognam "FWP"))
((or (= (getvar "loginname") "CAD_5")
(= (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)
(ARCH:PutProps2004)
(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)
(ARCH:PutProps2004)
(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))