Author Topic: Determine if Boundary Was Created  (Read 1234 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1254
Determine if Boundary Was Created
« on: October 23, 2018, 02:35:59 PM »
I have some code that will create a boundary if nothing is selected, the problem is sometime there may be nothing to create a boundary with and I need to account for this. So does anyone know how I could check if a boundary was created, because currently this code will add the last object drawn in the drawing, even if that wasn't a boundary.

Code: [Select]
(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 "")
)
)
)
)

cmwade77

  • Swamp Rat
  • Posts: 1254
Re: Determine if Boundary Was Created
« Reply #1 on: October 23, 2018, 03:07:19 PM »
Ok, it may not be perfect, but I have found a way to do this thanks to Lee's code from http://forums.augi.com/archive/index.php/t-76366.html (talk about digging back a ways)

Here is my code as it currently stands, if anyone sees anything that can be improved, please let me know. Also, as always I try to make sure all code that is from others is documented properly, but if I am using some of your code and you don't see your name, please let me know.

Code: [Select]
(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)
)

ronjonp

  • Needs a day job
  • Posts: 7200
Re: Determine if Boundary Was Created
« Reply #2 on: October 23, 2018, 03:29:36 PM »
I've used something like this in the past:
Code - Auto/Visual Lisp: [Select]
  1. (setq pt1
  2.        (getpoint
  3.          "\rSelect upper left corner of boundary for forms or a blank space to automatically find boundary:"
  4.        )
  5. )
  6. (setq chk (entlast))
  7. (command "._-boundary" pt1 "")
  8. (cond ((not (eq (entlast) chk)) (entlast)))

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

Grrr1337

  • Swamp Rat
  • Posts: 743
Re: Determine if Boundary Was Created
« Reply #3 on: October 23, 2018, 04:58:09 PM »
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.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

cmwade77

  • Swamp Rat
  • Posts: 1254
Re: Determine if Boundary Was Created
« Reply #4 on: October 23, 2018, 05:00:11 PM »
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.
Not what I need in this instance, but very handy for something else I need to work on, thank you.

VovKa

  • Swamp Rat
  • Posts: 1282
  • Ukraine
Re: Determine if Boundary Was Created
« Reply #5 on: October 23, 2018, 05:08:44 PM »
you can also use (bpoly pt1)
it will return entname if operation's successful and nil otherwise

cmwade77

  • Swamp Rat
  • Posts: 1254
Re: Determine if Boundary Was Created
« Reply #6 on: October 23, 2018, 06:52:09 PM »
you can also use (bpoly pt1)
it will return entname if operation's successful and nil otherwise
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.

cmwade77

  • Swamp Rat
  • Posts: 1254
Re: Determine if Boundary Was Created
« Reply #7 on: October 23, 2018, 06:55:15 PM »
This is what my code now looks like (for those that would like to know, this is used to insert Title 24 forms onto drawings, saves a lot of time over manually inserting 30+ pages of a PDF and making sure they don't overlap, etc.):
Code: [Select]
(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)
)

cmwade77

  • Swamp Rat
  • Posts: 1254
Re: Determine if Boundary Was Created
« Reply #8 on: October 23, 2018, 08:01:35 PM »
If anyone has some ideas on how to make this code run faster when inserting PDFs, I would greatly appreciate it.

ronjonp

  • Needs a day job
  • Posts: 7200
Re: Determine if Boundary Was Created
« Reply #9 on: October 24, 2018, 10:08:26 AM »
Do these 'title 24' forms change? If not I'd make an xref with all the sheets and reference that.

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

cmwade77

  • Swamp Rat
  • Posts: 1254
Re: Determine if Boundary Was Created
« Reply #10 on: October 24, 2018, 11:17:34 AM »
The title 24 forms are different for every project and the number of pages vary per project. They are always PDFs, but once attached once per project the number of pages generally don't change, so we just overwrite the PDF.

It is just my code takes a while with some PDFs to insert them, not sure why some work faster than others.