Hello!
Im working on a lisp and want to add a code section that brings in a detail title block (the block would already exist in the drawing, so copying it and pasting it would not be a problem) and places it in any page where I'm inserting a pdf xref. Now, the interesting part is that I would want, if possible, for the value of the title block to change to the name of the pdf Im selecting to open in that particular page/layout tab. Is there any way you guys can conceive doing that?
EX: I run the below code, and I select to insert the pdf called "large gallon tank", I'd then want the code to insert a block called "DETL_TITLE" at "6.0, 0.75", scale "1" and have the name attribute of that block change to "large gallon tank".
BUPSUP(defun c:BUPSUP ( / )
(c:BUPSUP)
)
(defun c:BUPSUP
(
/
; Functions
MN:ListBox _PDFPageCount findEmptySlot IncrementSheet ClearSheet
;Variables
dir lst mfr specs inspts pt scl pages page_lst cur_layout
)
(cb:writetotext "networks" "SPCI")
(vl-load-com)
(defun MN:ListBox ( title lst bit / *error* dch des tmp res )
(defun *error* ( msg )
(if (< 0 dch)
(unload_dialog dch)
)
(if (= 'file (type des))
(close des)
)
(if (and (= 'str (type tmp)) (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
(
(not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat
"listbox : dialog
{
label = \"" title "\";
spacer;
: list_box
{
key = \"list\";
multiple_select = " (if (null bit) "false" "true")";
}
width = 50;
fixed_width = true;
spacer;
ok_cancel;
}"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError loading list box.")
)
( 1
(start_list "list")
(foreach item lst (add_list item))
(end_list)
(setq res (set_tile "list" "0"))
(action_tile "list" "(setq res $value)")
(setq res
(if (= 1 (start_dialog))
(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" res ")")))
)
)
)
)
(if (< 0 dch)
(setq dch (unload_dialog dch))
)
(if (and (= 'str (type tmp)) (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
(if (not (null res))
res
nil
)
)
(defun _PDFPageCount ( filename / fob fso mat reg res str )
(if
(and
(setq filename (findfile filename))
(eq ".PDF" (strcase (vl-filename-extension filename)))
)
(vl-catch-all-apply
(function
(lambda ( / _ReadAsTextFile _CountPage )
(defun _ReadAsTextFile ( fso fn / fob str res )
(setq
fob (vlax-invoke fso 'getfile fn)
str (vlax-invoke fso 'opentextfile fn 1 0)
res (vlax-invoke str 'read (vlax-get fob 'size))
)
(vlax-invoke str 'close)
(vlax-release-object str)
(vlax-release-object fob)
res
)
(defun _CountPage ( rgx str / mat pag )
(vlax-put-property rgx 'pattern "/Type\\s*/Page[^s]")
(vlax-put-property rgx 'ignorecase actrue)
(vlax-put-property rgx 'global actrue)
(setq
mat (vlax-invoke rgx 'execute str)
pag (vlax-get mat 'count)
)
(vlax-release-object mat)
(if (zerop pag) 1 pag)
)
(setq
fso (vlax-create-object "Scripting.FileSystemObject")
reg (vlax-create-object "VBScript.RegExp")
str (_ReadAsTextFile fso filename)
res (_CountPage reg str)
)
)
)
)
)
(foreach obj (list str fob mat fso reg)
(vl-catch-all-apply 'vlax-release-object (list obj))
)
res
)
;; Translation by Lee Mac of the VBScript code by Chanh Ong
;; found at http://docs.ongetc.com/?q=content/pdf-pages-counting-using-vb-script
;;
;; Call with fully qualified filename of PDF file:
;; (_PDFPageCount "C:\\Folder\\Filename.pdf")
;;
;; Returns integer describing number of pages in specified PDF file
(defun findEmptySlot ( lst / i ent nums )
;; CONVERT LST "1.009,2.869,3.14" -> (LIST 1.009 2.869 3.14)
(setq i 0)
(cond
((eq 'STR (type (nth i lst)))
(setq nums (mapcar '(lambda (x y) (cons (atof (substr x 1 (vl-string-search "," x))) (atof (substr y (+ (vl-string-search "," y) 2))))) lst lst))
(while (and (setq ent (nentselp "" (list (car (nth i nums)) (cdr (nth i nums))))) (/= i (1- (length lst))))
;(vl-remove-if-not '(lambda (x) (wcmatch x "*R-*")) (layoutlist))
(setq i (1+ i))
)
(if (null ent)
(nth i lst)
)
)
)
)
(defun ClearSheet ( ss / ind ent )
(repeat (setq ind (sslength ss))
(setq
ind (1- ind)
ent (ssname ss ind)
)
(entdel ent)
)
(princ)
)
; [SS] SELECTION SET
; CLEARS OUT ALL ENTITIES PASSED AS SELECTION SET [SS]
(defun IncrementSheet ( sht / sht+ )
(setq sht+
(strcat
(substr sht 1 (1+ (vl-string-search "-" sht)))
(rtos (1+ (atoi (substr sht (+ (vl-string-search "-" sht) 2)))) 2 0)
)
)
)
;;; MAIN ;;;
(setq dir "C:\\_Vault\\ATC\\DAS\\_DAS Library\\BUP Supplementals")
(if (not (vl-file-directory-p dir))
(princ (strcat "Directory: " dir "\nNot found.\nPlease download/'GET' this location from Vault."))
(progn
(setq lst (vl-remove-if '(lambda (x) (and (member x (list "." ".." "_V")))) (vl-directory-files dir nil -1)))
(if
(and
(setq mfr (car (MN:ListBox "Select Generator Manufacturer:" lst nil)))
(setq specs (MN:ListBox "Select Generator Spec Sheet(s):" (vl-directory-files (strcat dir "\\" mfr) "*.pdf*" 1) 1))
)
(progn
(setq
inspts (list
"0.60475,1.38142"
"7.42514,1.38142"
)
scl "0.77272727"
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'setvar (list "CTAB" "R-601")))
(princ "\nError.\nLayout tab 'R-601' does not exist.")
(foreach spec specs
;(command-s "PDFATTACH" (strcat dir "\\" mfr "\\" spec))
(setq pages (_PDFPageCount (strcat dir "\\" mfr "\\" spec)))
(setq page_lst nil)
(repeat pages
(setq page_lst (cons (rtos pages 2 0) page_lst))
(setq pages (1- pages))
)
(setq page_lst (MN:Listbox (strcat "Select " spec " sheet(s):") page_lst 1))
(foreach p page_lst
(setq cur_layout (getvar "CTAB"))
(while
(not
(cond
((setq pt (findEmptySlot inspts))
; insertion point or nil
T
)
((vl-catch-all-error-p (vl-catch-all-apply 'setvar (list "CTAB" (setq cur_layout (IncrementSheet (getvar "CTAB"))))))
; T or nil
(command "_.LAYOUT" "C" (getvar "CTAB") cur_layout)
(setvar "CTAB" cur_layout)
(ClearSheet (ssget "C" '(0.60475 9.88142) '(13.9933 1.38142)))
(setq pt (findEmptySlot inspts))
)
)
)
)
(command "-PDFATTACH" (strcat dir "\\" mfr "\\" spec) p pt scl "0.0" nil)
(setq pt nil)
)
)
)
)
(princ "\nFunction canceled")
)
)
)
(princ)
)
;;;---------------------------------------------------------------------------------------------
; ...
; ...
;;;---------------------------------------------------------------------------------------------Attached is the lisp code and the template to help with context. Feel free to set the setq dir "C:\\_Vault\\ATC\\DAS\\_DAS Library\\BUP Supplementals" to any location to test the code with any pdf
Thanks!
