Topic: dwg properties question

[andrew_nao]

does anyone have any sample code that will allow me to palce more then 1 comment line in the dwg properties?

thanks for any and all help
here is the code im using

Code: [Select]


(defun C:addprops1 (/ App Doc DwgProps lanme dname pname)
(setq App (vlax-Get-Acad-Object)
Doc (vla-Get-ActiveDocument App)
DwgProps (vla-Get-SummaryInfo Doc)
)
  (setq lname (getvar "loginname"))
  (setq dname (vl-filename-base (getvar "dwgname")))
  (setq pname (vl-Filename-Base
(vl-Filename-Directory (getvar "Dwgprefix"))
      )
  )
  (vla-put-author dwgprops lname)
  (if (vl-catch-all-apply
'vla-removecustombykey
(list dwgprops "AmdtFileType")
      )
    ;(vla-addcustominfo dwgprops "AmdtFileType" "84")
    (progn
      (vl-catch-all-apply
'vla-removecustombykey
(list dwgprops "Job No.")
      )
      (vla-addcustominfo dwgprops "Job No." pname)
    )
  )
  (if (vl-catch-all-apply
'vla-removecustombykey
(list dwgprops "Job No.")
      )
    (vla-addcustominfo dwgprops "Job No." pname)
    (progn
      (vl-catch-all-apply
'vla-removecustombykey
(list dwgprops "Job No.")
      )
      (vla-addcustominfo dwgprops "Job No." pname)
    )
  )
  (if (vl-catch-all-apply
'vla-removecustombykey
(list dwgprops "DWG Name")
      )
    (vla-addcustominfo dwgprops "DWG Name" dname)
    (progn
      (vl-catch-all-apply
'vla-removecustombykey
(list dwgprops "DWG Name")
      )
      (vla-addcustominfo dwgprops "DWG Name" dname)
    )
  )


(vla-put-comments dwgprops "New comments1")
(vla-put-comments dwgprops "New comments2")
(vla-put-keywords dwgprops "New keywords")
(vla-put-subject dwgprops "Subject")
(vla-put-Title dwgprops "Title")
(setq bla bb)
(princ)
)



[daron]

(vla-put-comments dwgprops (strcat "Comment 1 " "comment 2 " "comment 3"))
Would that help?

[andrew_nao]

(vla-put-comments dwgprops (strcat "Comment 1 " "comment 2 " "comment 3"))
Would that help?

yea that works but its one giant line
i was looking for individual lines, i guess i should of said that from the start, sorry on that

[daron]

Are you saying that the text is one line like: "this is this and that is that" and you want to break it up into different (vla-put-comments...) chunks, or that when it's combined you want the (vla-put-comments...) line to be shorter?

If it's the latter, set variables to each individual string and then use strcat on the variables.

If it's the former, you may have to use vl-string-search to find space positions, then substr to extract the words you want.

If those are wrong altogether, the only other thing I can think of that you're asking by looking at your code is that you want to add the comments each time they appear, in which case, it sounds like you're needing to iterate through a list. Have you tried mapcar or foreach?

[VovKa]

for individual lines

Code: [Select]

(vla-put-comments dwgprops (strcat "Comment 1\r\n" "comment 2\r\n" "comment 3\r\n"))


[GDF]

Here is how i do it:

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;; 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 <few@autodesk.com>
;;; 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 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)
                (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))
;;;(vla-put-comments dwgprops (strcat "Comment 1\r\n" "comment 2\r\n" "comment 3\r\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;; 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 ----- ***"))))))
  (C:ADDPROPS)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ADDPROPS (/ doc db si author lname dname pname cname ProjectNum)
  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (setq db (vla-get-Database doc))
  (setq si (vla-get-SummaryInfo db))
  (setq lname (getvar "loginname"))
  (setq dname (vl-filename-base (getvar "dwgname")))
  ;;(setq pname (vl-Filename-Base (vl-Filename-Directory (getvar "Dwgprefix"))))
  (setq pname (nth 3 (ARCH:Split (getvar "dwgprefix") "\\")))
  ;;(setq pname (substr (getvar "dwgprefix") 14 6))
  (cond ((/= (atoi pname) 0) (setvar "users1" pname)))
  (cond ((/= (getvar "users1") 0)
         (setq cname
                (dos_getini
                  "PROJECTS"
                  (getvar "users1")
                  (strcat ARCH#CUSF "FILE/ARCH_Projects.ini")))))
;;;
  (cond ((= cname nil) (setq cname ""))((/= cname nil)(setq cname cname)))
;;;
  (vla-put-author si lname)
  (if (vl-catch-all-apply
'vla-removecustombykey
(list si "Job No.")
      )
    (vla-addcustominfo si "Job No." pname)
    (progn
      (vl-catch-all-apply
'vla-removecustombykey
(list si "Job No.")
      )
      (vla-addcustominfo si "Job No." pname)
    )
  )
  (if (vl-catch-all-apply
'vla-removecustombykey
(list si "Dwg Name")
      )
    (vla-addcustominfo si "Dwg Name" dname)
    (progn
      (vl-catch-all-apply
'vla-removecustombykey
(list si "Dwg Name")
      )
      (vla-addcustominfo si "Dwg Name" dname)
    )
  )
  (if (vl-catch-all-apply
'vla-removecustombykey
(list si "Project")
      )
    (vla-addcustominfo si "Project" cname)
    (progn
      (vl-catch-all-apply
'vla-removecustombykey
(list si "Project")
      )
      (vla-addcustominfo si "Project" cname)
    )
  )
  (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))


[andrew_nao]

Gary, thats exactly what im looking for it to do
how your comments are listed.

thanks
ill look over your code and see how you did it

[andrew_nao]

Gary, if you dont mind me asking
wheni run your code to see how it works i get an error
; error: no function definition: ARCH:XREF_LIST
where is this being called? i cant seem to find it.

[GDF]

Gary, if you dont mind me asking
wheni run your code to see how it works i get an error
; error: no function definition: ARCH:XREF_LIST
where is this being called? i cant seem to find it.

Code: [Select]

(defun ARCH:XREF_LIST  ()
  (setq zlst nil)
  (setq zitm (tblnext "BLOCK" T))
  (while (/= zitm nil)
    (if (/= (assoc 1 zitm) nil)
      (progn (setq znam (cdr (assoc 2 zitm)))
             (setq zlst (append zlst (list (strcat "Attached Xref : " znam))))))
    (setq zitm (tblnext "BLOCK")))
  (if (/= zlst nil)
    ;;(setq zret (acad_strlsort zlst))
    (setq zret (acad_strlsort
                 (append zlst (list "Created using : Arch Program© for AutoCAD®"))))
    (setq zret nil)))


[andrew_nao]

thank you Gary
 

[GDF]

thank you Gary
 

Your welcome. Is it working now?

[andrew_nao]

yes it does, i "borrowed" some of your code to make it a bit different for me.
hope you dont mind 

[GDF]

yes it does, i "borrowed" some of your code to make it a bit different for me.
hope you dont mind 

Go for it, that is how I learn also. Glad you could use some of it.

Gary