(setq Pt1 (getpoint "\rSelect upper left corner of boundary for forms or a blank space to automatically find boundary:"))
(setq PtTemp (osnap Pt1 "_nea"))
(if (= PtTemp nil)
(progn
(command "._-boundary" Pt1 "")
(if <<<<Boundary Was Created>>>>
(progn
(setq BoundSS (ssadd))
(ssadd (entlast) BoundSS)
;<<do stuff>>
(command "._erase" BoundSS "")
)
)
)
)
(defun c:T24 (/ *ThisDrawing* *Space* *Layers* *Boundary* *PDF* *Pages* *Layout* *SS* *RowSS* *Single* *LayOutName* *LayoutBound* BoundSS Ct PtTemp Pt1 Pt2 Ins OrigIns OldIns SingleBound RowBound RowBoundTemp OldRowBound OldRowTemp PtA PtB PtDist PtTemp PtEnd)
;*************************************
;Supporting Functions:
;*************************************
;; ============ Insidep.lsp ===============
;;
;; MAIN FUNCTION DESCRIPTION:
;; Will determine whether a point lies
;; inside or outside an object.
;;
;; FUNCTION: insidep
;; ARGUMENTS:
;; Point to be tested.
;; Object Ename or VLA-Object
;;
;; FUNCTION: vlax-list->3D-point
;; ARGUMENTS:
;; List to be converted.
;; Flag to determine x or y.
;;
;; OBJECT COMPATIBILITY:
;; Everything except Viewport/Polygon Mesh.
;;
;; AUTHOR:
;; Copyright (c) 2009, Lee McDonnell
;; (Contact Lee Mac, CADTutor.net)
;;
;; PLATFORMS:
;; No Restrictions,
;; only tested in ACAD 2004.
;;
;; ========================================
(defun insidep (pt Obj / Obj Tol ang doc spc flag int lin xV yV)
(vl-load-com)
(or (eq 'VLA-OBJECT (type Obj))
(setq Obj (vlax-ename->vla-object Obj)))
(setq Tol (/ pi 6) ; Uncertainty
ang 0.0 flag T)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(while (and (< ang (* 2 pi)) flag)
(setq flag (and
(setq int
(vlax-invoke
(setq lin
(vla-addLine spc
(vlax-3D-point pt)
(vlax-3D-point
(polar pt ang
(if (vlax-property-available-p Obj 'length)
(vla-get-length Obj) 1.0)))))
'IntersectWith Obj
acExtendThisEntity))
(<= 6 (length int))
(setq xV (vl-sort (vlax-list->3D-point int T) '<)
yV (vl-sort (vlax-list->3D-point int nil) '<))
(or (<= (car xV) (car pt) (last xV))
(<= (car yV) (cadr pt) (last yV))))
ang (+ ang Tol))
(vla-delete lin))
flag)
(defun vlax-list->3D-point (lst flag)
(if lst
(cons ((if flag car cadr) lst)
(vlax-list->3D-point (cdddr lst) flag))))
(defun dtr (NoD)
(* pi (/ NoD 180.0))
)
(defun d2r (NoD)
(* pi (/ NoD 180.0))
)
(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 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 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 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 ** Command is not allowed in Model Space **")
)
)
(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
)
;*****************************
;End of Supporting Functions
;*************************************
(vl-load-com)
(setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object)) ;_ end of vla-get-activedocument
*Space*
(if (zerop (vla-get-activespace *ThisDrawing*))
(if (= (vla-get-mspace *ThisDrawing*) :vlax-true)
(vla-get-modelspace *ThisDrawing*) ; active VP
(vla-get-paperspace *ThisDrawing*)
)
(vla-get-modelspace *ThisDrawing*)
)
*Layers* (vla-get-layers *ThisDrawing*)
)
(setq *PDF* (getfiled "Select the Title 24 PDF" (T24Folder) "PDF" 8))
(if *PDF*
(setq *Pages* (pdfpagecount *PDF*))
(progn
(princ "\nNo PDF file selected, exiting!")
(exit)
)
)
(CW_deleteallbutcurrentlayout)
(setq *Layout* 1)
(command "._-layout" "_rename" "" (strcat "TITLE 24 COMPLIANCE FORMS - SHEET " (strcase (LM:int->words *Layout*))))
(setq Pt1 (getpoint "\rSelect upper left corner of boundary for forms or a blank space to automatically find boundary:"))
(setq PtTemp (osnap Pt1 "_nea"))
(if (= PtTemp nil)
(progn
(command "._-boundary" Pt1 "")
(if (insidep Pt1 (entlast))
(progn
(setq BoundSS (ssadd))
(ssadd (entlast) BoundSS)
(setq *LayoutBound* (LM:SSBoundingBox BoundSS))
(command "._erase" BoundSS "")
)
)
)
)
(if *LayoutBound*
(progn
(setq Pt1 (list (car (nth 0 *LayoutBound*)) (cadr (nth 1 *LayoutBound*)) 0)
Pt2 (list (car (nth 1 *LayoutBound*)) (cadr (nth 0 *LayoutBound*)) 0)
)
)
(progn
(setq Pt2 (getpoint Pt1 "\rSelect lower right corner of boundary for forms:"))
)
)
(setq Ct 2
Sc 0.8
*SS* (ssadd)
*RowSS* (ssadd)
)
(setq Ins Pt1
OrigIns Pt1
)
(if (> *Pages* 0)
(progn
(command "._-pdfattach" *PDF* 1 Ins Sc "0")
(ssadd (entlast) *SS*)
(ssadd (entlast) *RowSS*)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (polar OldIns (dtr 270) (distance OldIns (list (car (nth 0 RowBound)) (cadr (nth 1 RowBound)))))
)
(command "._move" (entlast) "" OldIns Ins)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (list (car (nth 1 RowBound)) (cadr (nth 0 RowBound)))
OldRowTemp nil
)
)
)
(while (< ct *Pages*)
(setq *Single* nil
*Single* (ssadd)
)
(command "._-pdfattach" *PDF* Ct Ins Sc "0")
(ssadd (entlast) *SS*)
(ssadd (entlast) *Single*)
(ssadd (entlast) *RowSS*)
(setq RowBound (LM:SSBoundingBox *RowSS*)
SingleBound (LM:SSBoundingBox *Single*)
OldIns Ins
Ins (list (car (nth 1 RowBound)) (cadr (nth 0 RowBound)))
ct (+ ct 1)
)
(if (/= OldRowTemp nil)
(progn
(if (< (cadr (nth 0 OldRowTemp)) (cadr (nth 1 SingleBound)))
(progn
(setq PtA (list 0 (cadr (nth 0 OldRowTemp)) 0)
PtB (list 0 (cadr (nth 1 SingleBound)) 0)
PtDist (distance PtA PtB)
PtTemp (list 0 0 0)
PtEnd (polar PtTemp (dtr 270) PtDist)
)
(command "move" *Single* "" PtTemp PtEnd)
(setq Ins (list (car (nth 1 RowBound)) (cadr Ins) 0))
(setq RowBound (LM:SSBoundingBox *RowSS*))
)
)
)
)
(if (> (car (nth 1 RowBound)) (car Pt2))
(progn
(ssdel (entlast) *RowSS*)
(setq OldRowTemp (LM:SSBoundingBox *RowSS*)
*RowSS* nil
*RowSS* (ssadd)
)
(ssadd (entlast) *RowSS*)
(setq RowBoundTemp (LM:SSBoundingBox *RowSS*))
(command "._move" (entlast) "" (nth 0 RowBoundTemp) (nth 0 RowBound))
(setq RowBoundTemp (LM:SSBoundingBox *RowSS*))
(setq Ins (nth 0 RowBoundTemp)
OldIns Ins
Ins (polar (nth 0 RowBound) (dtr 270) (distance OldIns (list (car (nth 0 RowBoundTemp)) (cadr (nth 1 RowBoundTemp)))))
)
(command "._move" (entlast) "" OldIns Ins)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (list (car (nth 1 RowBound)) (cadr (nth 0 RowBound)))
)
)
)
(if (< (cadr (nth 0 RowBound)) (cadr Pt2))
(progn
(setq *Layout* (+ *Layout* 1)
*LayoutName* (strcat "TITLE 24 COMPLIANCE FORMS - SHEET " (strcase (LM:int->words *Layout*)))
)
(command "._erase" (entlast) "")
(command "._-layout" "_copy" "" *LayoutName*)
(command "._layout" "set" *LayoutName*)
(CW_GoLast)
(command "._erase" "_W" Pt1 Pt2 "")
(setq Ins OrigIns
*RowSS* nil
*RowSS* (ssadd)
*SS* nil
*SS* (ssadd)
)
(command "._-pdfattach" *PDF* CT Ins Sc "0")
(ssadd (entlast) *SS*)
(ssadd (entlast) *RowSS*)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (polar OldIns (dtr 270) (distance OldIns (list (car (nth 0 RowBound)) (cadr (nth 1 RowBound)))))
)
(command "._move" (entlast) "" OldIns Ins)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (list (car (nth 1 RowBound)) (cadr (nth 0 RowBound)))
OldRowTemp nil
)
)
)
)
(princ)
)
While RJP provides the fastest and quickest solution, if you want to store a list of created objects from a command-call then you might want to check this thread (http://www.theswamp.org/index.php?topic=52594.msg574992#msg574992).Not what I need in this instance, but very handy for something else I need to work on, thank you.
you can also use (bpoly pt1)I was wondering if there was something like that, but I couldn't find it in the help file, is there any major difference in results between this and using the boundary command as described earlier? I have tried this and it seems to work, just wondering if there is any strange behavior that needs to be accounted for.
it will return entname if operation's successful and nil otherwise
(defun c:T24 (/ *ThisDrawing* *Space* *Layers* *Boundary* *PDF* *Pages* *Layout* *SS* *RowSS* *Single* *LayOutName* *LayoutBound* *IncludeFirstTwoPages* BoundPoly BoundSS2 BoundSS Ct PtTemp Pt1 Pt2 Ins OrigIns OldIns SingleBound RowBound RowBoundTemp OldRowBound OldRowTemp PtA PtB PtDist PtTemp PtEnd)
;*************************************
;Supporting Functions:
;*************************************
(defun dtr (NoD)
(* pi (/ NoD 180.0))
)
(defun d2r (NoD)
(* pi (/ NoD 180.0))
)
(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 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 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 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 ** Command is not allowed in Model Space **")
)
)
(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
)
;*****************************
;End of Supporting Functions
;*************************************
(vl-load-com)
(setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object)) ;_ end of vla-get-activedocument
*Space*
(if (zerop (vla-get-activespace *ThisDrawing*))
(if (= (vla-get-mspace *ThisDrawing*) :vlax-true)
(vla-get-modelspace *ThisDrawing*) ; active VP
(vla-get-paperspace *ThisDrawing*)
)
(vla-get-modelspace *ThisDrawing*)
)
*Layers* (vla-get-layers *ThisDrawing*)
)
(vla-StartUndoMark *ThisDrawing*)
(setq *PDF* (getfiled "Select the Title 24 PDF" (T24Folder) "PDF" 8))
(if *PDF*
(setq *Pages* (pdfpagecount *PDF*))
(progn
(princ "\nNo PDF file selected, exiting!")
(exit)
)
)
(CW_deleteallbutcurrentlayout)
(setq *Layout* 1)
(command "._-layout" "_rename" "" (strcat "TITLE 24 COMPLIANCE FORMS - SHEET " (strcase (LM:int->words *Layout*))))
;Code to set pages - *IncludeFirstTwoPages*
(while (= Pt1 nil)
(initget "Pages _Pages")
(if *IncludeFirstTwoPages*
(setq Pt1 (getpoint (strcat "\rSelect upper left corner of usable space or a blank space to automatically find boundary [inserting Pages one - " (lm:int->words *Pages*) "]:")))
(setq Pt1 (getpoint (strcat "\rSelect upper left corner of usable space or a blank space to automatically find boundary [inserting Pages three - " (lm:int->words *Pages*) "]:")))
)
(if (= Pt1 "Pages")
(progn
(if *IncludeFirstTwoPages*
(setq *IncludeFirstTwoPages* nil)
(setq *IncludeFirstTwoPages* T)
)
(setq Pt1 nil)
)
)
)
(setq PtTemp (osnap Pt1 "_nea"))
(if (= PtTemp nil)
(progn
(setq BoundPoly (bpoly Pt1));Thanks to VovKa for pointing out the bpoly function
(princ)
(if BoundPoly
(progn
(setq BoundSS (ssadd))
(ssadd BoundPoly BoundSS)
(setq *LayoutBound* (LM:SSBoundingBox BoundSS))
(command "._erase" BoundSS "")
)
)
)
)
(if *LayoutBound*
(progn
(setq Pt1 (list (car (nth 0 *LayoutBound*)) (cadr (nth 1 *LayoutBound*)) 0)
Pt2 (list (car (nth 1 *LayoutBound*)) (cadr (nth 0 *LayoutBound*)) 0)
)
)
(progn
(setq Pt2 (getpoint Pt1 "\rSelect lower right corner of boundary for forms:"))
)
)
(setq Sc 0.8
*SS* (ssadd)
*RowSS* (ssadd)
)
(if *IncludeFirstTwoPages*
(setq Ct 1)
(setq Ct 3)
)
(setq Ins Pt1
OrigIns Pt1
)
(if (> *Pages* 0)
(progn
(command "._-pdfattach" *PDF* Ct Ins Sc "0")
(setq Ct (+ Ct 1))
(ssadd (entlast) *SS*)
(ssadd (entlast) *RowSS*)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (polar OldIns (dtr 270) (distance OldIns (list (car (nth 0 RowBound)) (cadr (nth 1 RowBound)))))
)
(command "._move" (entlast) "" OldIns Ins)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (list (car (nth 1 RowBound)) (cadr (nth 0 RowBound)))
OldRowTemp nil
)
)
)
(while (< ct *Pages*)
(setq *Single* nil
*Single* (ssadd)
)
(command "._-pdfattach" *PDF* Ct Ins Sc "0")
(ssadd (entlast) *SS*)
(ssadd (entlast) *Single*)
(ssadd (entlast) *RowSS*)
(setq RowBound (LM:SSBoundingBox *RowSS*)
SingleBound (LM:SSBoundingBox *Single*)
OldIns Ins
Ins (list (car (nth 1 RowBound)) (cadr (nth 0 RowBound)))
ct (+ ct 1)
)
(if OldRowPt
(progn
(if (< (cadr OldRowPt) (cadr (nth 1 SingleBound)))
(progn
(setq PtA (list 0 (cadr OldRowPt) 0)
PtB (list 0 (cadr (nth 1 SingleBound)) 0)
PtDist (distance PtA PtB)
PtTemp (list 0 0 0)
PtEnd (polar PtTemp (dtr 270) PtDist)
)
(command "move" *Single* "" PtTemp PtEnd)
(setq Ins (list (car (nth 1 RowBound)) (cadr Ins) 0))
(setq RowBound (LM:SSBoundingBox *RowSS*))
)
)
)
)
(if (> (car (nth 1 RowBound)) (car Pt2))
(progn
(ssdel (entlast) *RowSS*)
(setq OldRowTemp (LM:SSBoundingBox *RowSS*)
OldRowPt (nth 0 OldRowTemp)
*RowSS* nil
*RowSS* (ssadd)
)
(ssadd (entlast) *RowSS*)
(setq RowBoundTemp (LM:SSBoundingBox *RowSS*))
(command "._move" (entlast) "" (nth 0 RowBoundTemp) (nth 0 RowBound))
(setq RowBoundTemp (LM:SSBoundingBox *RowSS*))
(setq Ins (nth 0 RowBoundTemp)
OldIns Ins
Ins (polar (nth 0 RowBound) (dtr 270) (distance OldIns (list (car (nth 0 RowBoundTemp)) (cadr (nth 1 RowBoundTemp)))))
)
(command "._move" (entlast) "" OldIns Ins)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (list (car (nth 1 RowBound)) (cadr (nth 0 RowBound)))
)
)
)
(if (< (cadr (nth 0 RowBound)) (cadr Pt2))
(progn
(setq *Layout* (+ *Layout* 1)
*LayoutName* (strcat "TITLE 24 COMPLIANCE FORMS - SHEET " (strcase (LM:int->words *Layout*)))
)
(ssdel (entlast) *SS*)
(setq BoundSS2 (LM:SSBoundingBox *SS*))
(if BoundSS2
(command "._move" *SS* "" "_mtp" (nth 0 BoundSS2) (nth 1 BoundSS2) "_mtp" Pt1 Pt2)
)
(setq BoundSS2 nil)
(setq ct (- ct 1))
(command "._erase" (entlast) "")
(command "._erase" *SS* "")
(command "._-layout" "_copy" "" *LayoutName*)
(command "._oops")
(command "._layout" "set" *LayoutName*)
(CW_GoLast)
(command "._erase" "_W" Pt1 Pt2 "")
(setq Ins OrigIns
*RowSS* nil
*RowSS* (ssadd)
*SS* nil
*SS* (ssadd)
)
(command "._-pdfattach" *PDF* CT Ins Sc "0")
(ssadd (entlast) *SS*)
(ssadd (entlast) *RowSS*)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (polar OldIns (dtr 270) (distance OldIns (list (car (nth 0 RowBound)) (cadr (nth 1 RowBound)))))
)
(command "._move" (entlast) "" OldIns Ins)
(setq RowBound (LM:SSBoundingBox *RowSS*)
OldIns Ins
Ins (list (car (nth 1 RowBound)) (cadr (nth 0 RowBound)))
OldRowTemp nil
OldRowPt (list (car Pt2) (cadr Pt1) 0)
)
)
)
)
(setq BoundSS2 (LM:SSBoundingBox *SS*))
(if BoundSS2
(command "._move" *SS* "" "_mtp" (nth 0 BoundSS2) (nth 1 BoundSS2) "_mtp" Pt1 Pt2)
)
(setq BoundSS2 nil)
(setvar "PDFFRAME" 0)
(vla-EndUndoMark *ThisDrawing*)
(princ)
)