I have gotten it mostly working, but I am still having some problems with a situation, such as the one that is attached (and yes, there is an intentionally blank page in there for testing purposes)
Here is the current code:
(defun c:T24 (/ *ACAD_DOC* *ACAD_LAYERS* PDFFile PageCount Pt1 Pt2 All XDist YDist ScaledCol ScaledRow Cols Rows LgPtr Ins Sc FirstIns LastIns RowIns Sht Row Col Ct ReIns Pg minPt maxPt SS t24Pt1 t24Pt2 TmpPt LastEnt OldYDif RowSS OldPtA OldPtB NewPtA NewPtB OldRowSS)
(vl-load-com)
(setq *ACAD_DOC* (vla-get-ActiveDocument (vlax-get-acad-object))
*ACAD_LAYERS* (vla-get-layers *ACAD_DOC*)
)
;Supporting Functions
(defun LM:SSBoundingBox ( ss / i l1 l2 ll ur );I believe this code is originally from Lee Mac, unfortunately the code that I found online didn't have it attributed to the original source
(repeat (setq i (sslength ss))
(vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur)
(setq
l1 (cons (vlax-safearray->list ll) l1)
l2 (cons (vlax-safearray->list ur) l2)
)
)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list l1 l2))
)
(defun LM:int->words ( n / f1 f2 );Converts Numbers into words - Lee Mac's Code from: http://www.theswamp.org/index.php?action=post;quote=491140;topic=43830.0;last_msg=491781
(defun f1 ( n )
(if (< n 20)
(nth (fix n) '("" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"))
(strcat (nth (- (fix (/ n 10)) 2) '("twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety")) " " (f1 (rem n 10)))
)
)
(defun f2 ( n l )
(cond
( (null l) (f1 n))
( (< n (caar l)) (f2 n (cdr l)))
( (vl-string-right-trim " " (strcat (f2 (fix (/ n (caar l))) (cdr l)) " " (cadar l) " " (f2 (rem n (caar l)) (cdr l)))))
)
)
(if (zerop n)
"zero"
(vl-string-right-trim " "
(f2 n
'(
(1e18 "quintillion")
(1e15 "quadrillion")
(1e12 "trillion")
(1e09 "billion")
(1e06 "million")
(1e03 "thousand")
(1e02 "hundred")
)
)
)
)
)
(defun PDFPageCount ( filename / fob fso mat reg res str )
;; 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
(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
)
(defun T24Folder (/ Folder POS TFolder)
(setq Folder (strcase (getvar "dwgprefix"))
Pos (vl-string-search "CAD" Folder)
)
(cond
(Pos
(setq TFolder (strcat (substr Folder 1 Pos) "Calcs\\Mechanical\\T24\\Reports\\"))
(if (vl-file-directory-p TFolder)
(progn
(setq Folder TFolder)
)
)
)
)
Folder
)
(defun delta (p1 p2 ord)
(abs (- (nth ord p1) (nth ord p2)))
)
(defun pdf_temp (/ Obj yDif TmpYPt TmpPts)
(if (not RowSS)
(setq RowSS (ssadd))
)
(setq Obj (vlax-ename->vla-object (entlast)))
(vla-getboundingbox Obj 'minPt 'maxPt)
(setq minPt (vlax-safearray->list minPt)
maxPt (vlax-safearray->list maxPt)
)
(cond
((> (car maxPt) LgPtr)
(command "._undo" "1")
(setq Col Cols
ReIns T
)
)
(T
(ssadd (entlast) SS)
(ssadd (entlast) RowSS)
)
)
(setq yDif (delta minPt maxPt 1))
(if (> (sslength RowSS) 0)
(setq TmpPts NewPts
NewPts (LM:SSBoundingBox RowSS)
)
)
(cond
((< Col Cols)
(Setq Col (+ Col 1)
Ins (polar (list (car maxPt) (cadr minPt)) (dtr 180) (* 0.488 Sc))
)
)
(T
(if (not ReIns)
(progn
(command "._-pdfattach" PDFFile (+ Pg 1) Ins Sc "0")
(setq Obj (vlax-ename->vla-object (entlast)))
(vla-getboundingbox Obj 'minPt 'maxPt)
(setq minPt (vlax-safearray->list minPt)
maxPt (vlax-safearray->list maxPt)
)
(setq yDif (delta minPt maxPt 1))
(command "._undo" "1")
)
)
(setq Ins RowIns
Ins (polar Ins (dtr 270) (+ yDif (* 0.488 SC)))
RowIns Ins
)
(setq OldPtA (nth 0 OldPts)
OldPtB (nth 1 OldPts)
NewPtA (nth 0 NewPts)
NewPtB (nth 1 NewPts)
yDiff (delta OldPtB NewPtB 1)
)
(command "._move" RowSS "" (list (car OldPtA) (cadr OldPtB)) (strcat "@" (rtos yDiff 2 15) "<270"))
(setq RowSS nil)
(cond
((< Row Rows)
(setq Row (+ Row 1)
Col 1
)
)
(T
(setq ct (+ ct 1)
Ins FirstIns
RowIns Ins
RowMaxIn Ins
Col 1
Row 1
)
(if (> CT 1)
(progn
(if SS
(progn
(setq TmpPt (LM:SSBoundingBox SS))
(command "._move" SS "" "mtp" (nth 0 TmpPt) (nth 1 TmpPt) "mtp" Pt1 Pt2)
(setq SS nil
TmpPt nil
SS (ssadd)
)
)
)
(command "._-layout" "_copy" "BEI-T24-TEMP" (strcat "MECHANICAL TITLE 24 COMPLIANCE FORMS - SHEET " (strcase (LM:int->words Ct))))
)
)
(command "._layout" "set" (strcat "MECHANICAL TITLE 24 COMPLIANCE FORMS - SHEET " (strcase (LM:int->words Ct))))
(CW_GoLast)
)
)
)
)
)
(defun CW_deleteallbutcurrentlayout (/); From RonJonP at http://www.cadtutor.net/forum/showthread.php?35718-delete-all-layouts-except-current&p=234874&viewfull=1#post234874
(vlax-map-collection
(vla-get-layouts
(vla-get-activedocument (vlax-get-acad-object))
)
'(lambda (lay)
(if (/= (vla-get-name lay) (getvar 'ctab))
(vl-catch-all-apply 'vla-delete (list lay))
)
)
)
)
(defun CW_GoLast (/ l)
;; Tharwat 16.Dec.2014 ;;
(if (and (< 2
(vla-get-count
(setq l (vla-get-Layouts
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
)
)
(eq 0 (getvar 'TILEMODE))
)
(vla-put-taborder
(vla-item l (getvar 'CTAB))
(1- (vla-get-count l))
)
(princ "\n ** Commnad is not allowed in Model Space **")
)
)
;End of Supporting Functions
(while (not PDFFile)
(setq PDFFile (getfiled "Select the Title 24 PDF" (T24Folder) "PDF" 8))
)
(setq PageCount (pdfpagecount PDFFile))
(while (not Pt1)
(cond
(All
(initget "noCover _noCover")
(setq Pt1 (getpoint (strcat "\rSelect first corner of boundary for PDFs (inserting pages 1 - " (rtos PageCount 2 0) ") [do not insert Cover pages]: ")))
(cond
((= Pt1 "noCover")
(setq All nil
Pt1 nil
)
)
)
)
(T
(initget "Allpages _Allpages")
(setq Pt1 (getpoint (strcat "\rSelect first corner of boundary for PDFs (inserting pages 3 - " (rtos PageCount 2 0) ") [insert All pages]: ")))
(cond
((= Pt1 "Allpages")
(setq All T
Pt1 nil
)
)
)
)
)
)
(while (not Pt2)
(setq Pt2 (getcorner Pt1 "\rSelect opposite corner of boundary for PDFs: "))
)
(setq XDist (abs (- (car Pt1) (car Pt2)))
YDist (abs (- (cadr Pt1) (cadr Pt2)))
ScaledCol (fix (/ XDist 6.312))
ScaledRow (fix (/ YDist 8.12))
Cols (fix (/ XDist 7.89))
Rows (fix (/ YDist 10.15))
LgPtr (max (car Pt1) (car Pt2))
Ins (list
(apply 'min (mapcar 'car (list Pt1 Pt2)))
(apply 'max (mapcar 'cadr (list Pt1 Pt2)))
)
)
(cond
((> (* ScaledCol ScaledRow) (* Cols Rows))
(setq Cols ScaledCol
Rows ScaledRow
Sc 0.8
)
)
(T
(setq Sc 1)
)
)
(setq Ins (polar Ins (dtr 270) (* 10.582 Sc))
Ins (polar Ins (dtr 180) (* 0.43 Sc))
FirstIns Ins
LastIns Ins
Row 1
Col 1
Sht 1
RowIns Ins
Ct 1
)
(if All
(setq Pg 1)
(setq Pg 3)
)
(vla-StartUndoMark *ACAD_DOC*)
(CW_deleteallbutcurrentlayout)
(command "._-layout" "_rename" "" (strcat "MECHANICAL TITLE 24 COMPLIANCE FORMS - SHEET " (strcase (LM:int->words Ct))))
(command "._-layout" "_copy" "" "BEI-T24-TEMP")
(while (<= Pg PageCount)
(if (not SS)
(setq SS (ssadd))
)
(command "._-pdfattach" PDFFile Pg Ins Sc "0")
(pdf_temp)
(cond
(ReIns
(command "._-pdfattach" PDFFile Pg Ins Sc "0")
(setq ReIns nil)
(pdf_temp)
)
)
(setq Pg (+ Pg 1))
)
(command "._-layout" "_delete" "BEI-T24-TEMP")
(setvar "pdfframe" 0)
(if SS
(progn
(setq TmpPt (LM:SSBoundingBox SS))
(command "._move" SS "" "mtp" (nth 0 TmpPt) (nth 1 TmpPt) "mtp" Pt1 Pt2)
)
)
(vla-EndUndoMark *ACAD_DOC*)
)
Really, if anyone can help with this, I would greatly appreciated, I get it so close, but something goes wrong in trying to set the old points and new points on a per row basis.
