;;;CORP 34x22 (ANSI D Size Sheet) Title Block Xref attachment function. ;;;Attach at 0,0; scale=1:1; angle=0°. ;;; ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; Edited: 5-8-2014 ;;; (DEFUN corp_D_sheet (/) (SETQ OLD_ATTREQ (GETVAR "ATTREQ")) (SETQ OLD_INSUNITS (GETVAR "INSUNITS")) (SETVAR "INSUNITS" 0) (SETVAR "ATTREQ" 0) (SETQ found_corp_fill NIL) (IF set_drive_letters NIL (LOAD "set_drive_letters" "\nFile SET_DRIVE_LETTERS.LSP not loaded! ")) (set_drive_letters) (SETQ corp_sheet_name "g01tbx01") (SETQ corp_fill_name "corpnewttbats") (SETQ corp_proj_drive work_drive) (SETQ corp_std_dwg_path (STRCAT work_drive "\\Util\\")) (SETQ ff-pathtokens (DOS_STRTOKENS (GETVAR "DWGPREFIX") "\\")) (SETQ ff-list NIL pathspec (STRCAT (CAR ff-pathtokens) "\\"); starts pathspec with :\\ ) (FOREACH n (CDR ff-pathtokens) (IF (AND n (/= n "")) (SETQ pathspec (STRCAT pathspec n "\\"));strcat each folder in succession to check in it for title block drawing (SETQ pathspec NIL) ) (IF (AND pathspec (SETQ this-ff (DOS_DIR (STRCAT pathspec "*" corp_sheet_name ".dwg")))) (SETQ ff-list (APPEND ff-list (LIST (STRCAT pathspec (CAR this-ff)))));create a list of title block drawings that might be used. ) ) (IF ff-list (PROGN (SETQ ff-list-len (LENGTH ff-list)) (SETQ ff-cnt 0) (IF (EQ use_def_ff "Yes") (SETQ use_def_ff "No")) (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")) (WHILE (AND(< ff-cnt ff-list-len)(/= use_def_ff "Yes")) (SETQ ff-pathspec (NTH ff-cnt ff-list)) (SETQ found_corp_sheet (DOS_RELATIVEPATH (STRCAT (GETVAR "DWGPREFIX")(GETVAR "DWGNAME")) ff-pathspec)) (IF found_corp_sheet (SETQ use_def_ff (ukword 1 "Yes No" (STRCAT "Use " found_corp_sheet " for this title block?") (IF use_def_ff use_def_ff "Yes"))) ) (SETQ ff-cnt (1+ ff-cnt)) ) ) (SETQ use_def_ff NIL) ) (COND ((EQ use_def_ff "Yes")); if "Yes" skip past these conditionals ;;; ((DOS_DIR (SETQ ff-pathspec (STRCAT (GETVAR "DWGPREFIX") "..\\*" corp_sheet_name ".dwg"))) ;;; (SETQ found_corp_sheet (FINDFILE ff-pathspec)) ;;; ) ;;; ((DOS_DIR (SETQ ff-pathspec (STRCAT (GETVAR "DWGPREFIX") "*" corp_sheet_name ".dwg"))) ;;; (SETQ found_corp_sheet (FINDFILE ff-pathspec)) ;;; ) ((FINDFILE (SETQ ff-pathspec (STRCAT "..\\" corp_sheet_name ".dwg"))) (SETQ found_corp_sheet (FINDFILE ff-pathspec)) (copy-tb-to-project-folder) ) ((FINDFILE (SETQ ff-pathspec (STRCAT corp_sheet_name ".dwg"))) (SETQ found_corp_sheet (FINDFILE ff-pathspec)) (copy-tb-to-project-folder) ) (T (IF DOS_COPY ;this function is part of McNeel & Associates free DOSLIB utility v6.1 (PROGN (DOS_DRIVE corp_proj_drive) (DOS_CHDIR (GETVAR "dwgprefix")) (SETQ prj810dir (GETVAR "dwgprefix")) (WHILE (WCMATCH prj810dir "*\\800*\\810*\\*\\*") (SETQ prj810dir (DOS_CHDIR "..\\"))) (IF (AND (DOS_COPY (STRCAT corp_std_dwg_path "G01TBX01.dwg\"") prj810dir) (DOS_COPY (STRCAT corp_std_dwg_path "corpnewttbats.dwg\"") prj810dir) ) ;_ end of AND (PROGN (SETQ found_corp_sheet (DOS_RELATIVEPATH (GETVAR "dwgprefix") (STRCAT prj810dir "G01TBX01.dwg"))) (SETQ found_corp_fill (DOS_RELATIVEPATH (GETVAR "dwgprefix") (STRCAT prj810dir "corpnewttbats.dwg"))) ) ;_ end of PROGN (COND ((AND(NOT found_corp_sheet)(NOT found_corp_fill)) (ALERT (STRCAT "Neither \"" corp_sheet_name "\" or \"" corp_fill_name "\" were found!"))) ((NOT found_corp_sheet) (ALERT (STRCAT "\"" corp_sheet_name "\" was not found!"))) ((NOT found_corp_fill) (ALERT (STRCAT "\"" corp_sheet_fill "\" was not found!"))) ) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of if ) ) ;_ end of COND (PROGN (IF DOS_RELATIVEPATH ;this function is part of McNeel & Associates free DOSLIB utility v6.1 (PROGN ;If this function is available the relative path will be used where possible (SETQ relblkname (DOS_RELATIVEPATH (GETVAR "dwgprefix") found_corp_sheet)) (IF relblkname (SETQ found_corp_sheet relblkname) ) ;_ end of if ) ;_ end of PROGN ) ;_ end of if (IF (EQ (GETVAR "tilemode") 1) (SETVAR "tilemode" 0) ) ;_ end of if (WHILE (WCMATCH found_corp_sheet "\\*") (SETQ found_corp_sheet (SUBSTR found_corp_sheet 2))) (SETQ corp_sheet_name (CADR (REVERSE (DOS_SPLITPATH found_corp_sheet)))) (COMMAND "-layer" "m" corp_sheet_name "") (IF (TBLSEARCH "block" corp_sheet_name) (PROGN (SETQ no_sheet NIL) (ENTMAKE (LIST (CONS 0 "INSERT") (CONS 2 corp_sheet_name) (CONS 8 corp_sheet_name) (CONS 10 (LIST 0.0 0.0 0.0)) (CONS 41 1.0) (CONS 42 1.0) (CONS 43 1.0) (CONS 50 0.0) ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of PROGN (PROGN (SETQ no_sheet NIL) (COMMAND "-xref" "o" found_corp_sheet "0,0" 1 1 0)) ) ;_ end of IF ) ;_ end of progn (IF (IF (AND (OR found_corp_fill (FINDFILE (STRCAT corp_fill_name ".dwg"))) found_corp_sheet) (IF found_corp_fill T (SETQ found_corp_fill (FINDFILE (STRCAT corp_fill_name ".dwg"))) ) ;_ end of IF (SETQ found_corp_fill (FINDFILE (STRCAT "..\\" corp_fill_name ".dwg"))) ) ;_ end of IF (IF (AND found_corp_fill found_corp_sheet) (PROGN (IF (WCMATCH (STRCASE found_corp_fill) "*\\*.DWG") (WHILE (WCMATCH (STRCASE found_corp_fill) "*\\*.DWG") (SETQ found_corp_fill (SUBSTR found_corp_fill 2)) ) ) ;_ end of IF (IF (EQ (GETVAR "tilemode") 1) (SETVAR "tilemode" 0) ) ;_ end of if (SETVAR "DIMSCALE" 0.0) (SETVAR "LTSCALE" 0.5) (COMMAND "-layer" "m" corp_fill_name "") (COMMAND ".zoom" "w" "0,0" "34,22") (COMMAND ".limits" "0,0" "34,22") (COMMAND "-insert" found_corp_fill "0,0" 1 1 0) (IF (FINDFILE (STRCAT (GETVAR "DWGPREFIX") "whodunit.scr")) (PROGN (COMMAND "script" (STRCAT (GETVAR "DWGPREFIX") "whodunit.scr")) ) (PROGN (COMMAND ".ddatte" "l") ) ) (IF setstdpage NIL (LOAD "setstdpage" "\nFile SETSTDPAGE.LSP not loaded! ")) (setstdpage "TIFF 34x22 288dpi PS") ) ;_ end of progn ) ;_ end of IF ) ;_ end of IF ;;; ) ;_ end of if (SETVAR "ATTREQ" OLD_ATTREQ) (SETVAR "INSUNITS" OLD_INSUNITS) (COND (no_sheet NIL) ((AND found_corp_sheet found_corp_fill) (PRINC)) (found_corp_fill (ALERT (STRCAT "\nSheet Border Drawing file\n\"" (STRCASE corp_sheet_name) ".DWG\" not found!\nAutoCAD support file search path should include " corp_std_dwg_path "\". " ) ;_ end of STRCAT ) ;_ end of ALERT ) (found_corp_sheet (ALERT (STRCAT "\nSheet Title Fill-in Drawing file\n\"" (STRCASE corp_fill_name) ".DWG\" not found!\nAutoCAD support file search path should include " corp_std_dwg_path "\". " ) ;_ end of STRCAT ) ;_ end of ALERT ) (T (ALERT (STRCAT "\nSheet Border and Title Fill-in Drawing files\n\"" (STRCASE corp_sheet_name) ".DWG, and " (STRCASE corp_fill_name) ".DWG\" not found!\nAutoCAD support file search path should include " corp_std_dwg_path "\". " ) ;_ end of STRCAT ) ;_ end of ALERT ) ) ;_ end of COND (SETQ corp_sheet_name nil) (SETQ corp_fill_name nil) (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN copy-tb-to-project-folder () (IF (WCMATCH (STRCASE (FINDFILE ff-pathspec)) (STRCASE (STRCAT "*\\UTIL\\" corp_sheet_name ".DWG"))) (PROGN (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")) (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! ")) (SETQ dest-folder-list (REVERSE (CDR (REVERSE (DOS_STRTOKENS (GETVAR "DWGPREFIX") "\\"))))) (COND ((>=(LENGTH dest-folder-list) 7) (SETQ path-kwstr "Yes No U1 U2 U3 U4 U5 U6" path-optstr "?[Yes/No/U1/U2/U3/U4/U5/U6]" )) ((=(LENGTH dest-folder-list) 6) (SETQ path-kwstr "Yes No U1 U2 U3 U4 U5" path-optstr "?[Yes/No/U1/U2/U3/U4/U5]" )) ((=(LENGTH dest-folder-list) 5) (SETQ path-kwstr "Yes No U1 U2 U3 U4" path-optstr "?[Yes/No/U1/U2/U3/U4]" )) ((=(LENGTH dest-folder-list) 4) (SETQ path-kwstr "Yes No U1 U2 U3" path-optstr "?[Yes/No/U1/U2/U3]" )) ((=(LENGTH dest-folder-list) 3) (SETQ path-kwstr "Yes No U1 U2" path-optstr "?[Yes/No/U1/U2]" )) ((=(LENGTH dest-folder-list) 2) (SETQ path-kwstr "Yes No U1" path-optstr "?[Yes/No/U1]" )) ((=(LENGTH dest-folder-list) 1) (SETQ path-kwstr "Yes No" path-optstr "?[Yes/No]" )) ) (SETQ docopytb (ukword 1 path-kwstr (STRCAT "Do you want to copy " (FINDFILE ff-pathspec) " to " (GETVAR "DWGPREFIX") path-optstr ) "Yes" ) ) (IF tbprefix NIL (SETQ tbprefix (CADDR (DOS_STRTOKENS (GETVAR "DWGPREFIX") " :\\")))) (SETQ tbprefix (USTR 1 "Enter a prefix for the new filename or ~ for none" (IF tbprefix tbprefix "") T)) (IF (WCMATCH tbprefix "`~") (SETQ tbprefix "") ) (COND ((EQ docopytb "Yes") (SETQ dest-path (STRCAT (GETVAR "DWGPREFIX") tbprefix corp_sheet_name ".dwg"))) ((EQ docopytb "U1") (SETQ dest-folder-list (REVERSE (CDR (REVERSE dest-folder-list)))) (SETq dest-folder-list (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) dest-folder-list)) (SETQ dest-folder (EVAL (CONS 'STRCAT dest-folder-list)))) ((EQ docopytb "U2") (SETQ dest-folder-list (REVERSE (CDDR (REVERSE dest-folder-list)))) (SETq dest-folder-list (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) dest-folder-list)) (SETQ dest-folder (EVAL (CONS 'STRCAT dest-folder-list)))) ((EQ docopytb "U3") (SETQ dest-folder-list (REVERSE (CDDDR (REVERSE dest-folder-list)))) (SETq dest-folder-list (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) dest-folder-list)) (SETQ dest-folder (EVAL (CONS 'STRCAT dest-folder-list)))) ((EQ docopytb "U4") (SETQ dest-folder-list (REVERSE (CDR (CDDDR (REVERSE dest-folder-list))))) (SETq dest-folder-list (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) dest-folder-list)) (SETQ dest-folder (EVAL (CONS 'STRCAT dest-folder-list)))) ((EQ docopytb "U5") (SETQ dest-folder-list (REVERSE (CDDR (CDDDR (REVERSE dest-folder-list))))) (SETq dest-folder-list (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) dest-folder-list)) (SETQ dest-folder (EVAL (CONS 'STRCAT dest-folder-list)))) ((EQ docopytb "U6") (SETQ dest-folder-list (REVERSE (CDDDR (CDDDR (REVERSE dest-folder-list))))) (SETq dest-folder-list (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) dest-folder-list)) (SETQ dest-folder (EVAL (CONS 'STRCAT dest-folder-list)))) ) (DOS_COPY (FINDFILE ff-pathspec) (SETQ found_corp_sheet (STRCAT (GETVAR "DWGPREFIX") tbprefix corp_sheet_name ".dwg"))) ) ) ) ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ;*** DO NOT add text below the comment! ***|;