TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ELOQUINTET on September 29, 2004, 01:16:08 PM

Title: custom fields lisp
Post by: ELOQUINTET on September 29, 2004, 01:16:08 PM

i don't have 2005 loaded on my machine here so i can't try this out but those of you who do give this a try and lemme know if it works. it's a part of the september cadalyst code now posted on their site

Code: [Select]

;;;CADALYST 09/04 Tip1978:  SFLD.LSP  Create Custom Fields (c) 2004 Leonid Nemirovsky

(defun c:sfld (/ ftitle fauthor fsubject fproj infoobj num num1 deside deside1 deside2 fld fldv pop)
(vl-load-com)
(setq FTITLE " ")
(setq FAUTHOR " ")
(setq FSUBJECT " ")
(setq FPROJ " ")

  (setq infoObj (vla-get-SummaryInfo (vla-get-activeDocument (vlax-get-acad-object))))
  (vla-put-Title infoObj FTITLE)
  (vla-put-Author infoObj FAUTHOR)
  (vla-put-Subject infoObj FSUBJECT)
  (vla-put-KeyWords infoObj FTITLE)
  (vla-put-Comments infoObj FPROJ)

(setq num (vla-NumCustomInfo infoObj))
(if
(> num 0)
 (progn
  (setq num1 (rtos num 2 0))
  (setq question (strcat "You have " num1 " CUSTOM FIELDS do you want to preview them? <Yes or No>: "))
  (initget 1"Yes No")
  (setq deside1 (getkword question))
  (if (= deside1 "Yes")(command "dwgprops"))
 )
)
    (initget 1 "Yes No")
    (setq deside2 (getkword "\nDo you want create custom FIELD? <Yes or No>: "))
    (if (= deside2 "No")(quit))

(while
 (setq FLD (getstring T "\nField NAME <XXX>: "))
 (if (= fld "")(setq fld "XXX"))
 (setq FLDV(getstring T "\nField VALUE <XXX>: "))
 (if (= fldv "")(setq fldv "XXX"))
 (vla-addCustomInfo infoObj FLD FLDV)
 (setq pop (strcat "%<\\AcVar CustomDP." fld ">%"))  
 (setq PT (getpoint "\nField Insertion Point: "))
 (command"mtext" pt "w" "0" pop "")    
    (initget 1 "Yes No")
    (setq deside (getkword "\nDo you want create another custom FIELD? <Yes or No>: "))
    (if (= deside "No")(quit))
)

(princ)
)