;;;Batch Plot subroutine called from Dialog BPLOT.LSP, Writes/uses script file. ;;;Uses DOSLib v3.0 for DOS file and directory operations, ;;;freeware courtesy of Robert McNeel & Associates. ;;;;Requires: PLBL.LSP, BPLOT.LSP, BPLOT.DCL, DLOG.LSP, PLTSTAMP.DWG ;;; ;;; ;;; ;;;> Author: Henry C. Francis ;;;> 425 N. Ashe St. ;;;> Southern Pines, NC 28387 ;;;> http://paracadd.com ;;;> All rights reserved. ;;; ;;;> COPYRIGHT: 7-20-94 ;;;> EDITED: 04-25-2002 ;;; (defun bplots (pltlst plotr pltscl pltare hidplt savdwg qitend orgdir out_to / fp1 str01 str1 str2 str3 count ) (if (wcmatch (dos_computer) "RAL*") (setq confirm_acct T) (setq confirm_acct NIL) ) ;_ end of if (if plotr (setq found_ppf (findfile (strcat plotr ".ppf"))) (setq plotr nil) ) ;_ end of if (if found_ppf (progn (setq plt_para3 NIL) (setq open_ppf (open found_ppf "r")) (setq plt_param (read-line open_ppf)) (setq plt_para1 (read-line open_ppf)) (setq plt_para2 (read-line open_ppf)) (while (setq plt_para (read-line open_ppf)) (if plt_para3 (setq plt_para3 (strcat plt_para3 " " plt_para)) (setq plt_para3 plt_para) ) ;_ end of if ) ;_ end of while (close open_ppf) ) ;_ end of progn (if jstscr nil (princ (strcat "\nERROR! File " plotr ".ppf not found! ")) ) ;_ end of if ) ;_ end of if (setq bplot_olderr *error*) (if (not pltscl) (setq pltscl "FUllscale") ) ;_ end of if ;;; (defun *error* (msg / ) ;;; (if fp1 (close fp1)) ;;; (princ "\nError: Plotter name (preferences) MUST match BPLOT plotter name exactly.\n") ;;; (princ msg) ;;; (setq *error* bplot_olderr) ;;; (princ) ;;; ) (if (eq (substr (getvar "acadver") 1 2) "15") nil (if jstscr (setq plotr (getvar "plotid")) (progn (setq default_lst nil kword_lst nil ) ;_ end of setq (foreach n ppf_lst (if (eq n plotr) nil (if default_lst (setq default_lst (strcat default_lst "<" n ">")) (setq default_lst (strcat "<" n ">")) ) ;_ end of if ) ;_ end of if (if kword_lst (setq kword_lst (strcat kword_lst " " n)) (setq kword_lst n) ) ;_ end of if ) ;_ end of foreach (princ "\nBPLOT will cancel if selected plotter has not been configured for this machine." ) ;_ end of princ (setq plotr (ukword 1 kword_lst (strcat "Please Confirm: Use " plotr " plotter or " default_lst "?" ) ;_ end of strcat ;_ end of strcat plotr ) ;_ end of ukword ) ;_ end of setq (setvar "plotid" plotr) ) ;_ end of progn ) ;_ end of if ) ;_ end of if (setq goplt T) (setq dimsc (getvar "dimscale")) (if (eq dimsc 0) (setq dimsc 1) ) ;_ end of if (if c:plbl nil (load "plbl") ) ;_ end of if (setq old_luprec (getvar "luprec")) (setvar "luprec" 4) (setvar "cmdecho" 0) (setvar "expert" 1) (setvar "filedia" 0) (setq osmod (getvar "osmode")) (setvar "osmode" 0) (setq dwgp (getvar "dwgprefix")) (setq dwgn (getvar "dwgname")) (setq dwgnl (strlen dwgn)) (if dos_username (setq lognm (dos_username)) (if (getenv "LGN") (setq lognm (getenv "LGN")) (setq lognm "NN") ) ;_ end of if ) ;_ end of if (if (eq (substr dwgn 1 6) (substr dwgp 1 6)) (setq cdwg dwgn) (setq cdwg (strcat orgdir dwgn)) ) ;_ end of if (setq oldscr (findfile (strcat pltdir lognm "bplot.scr"))) (if oldscr (dos_delete oldscr) ) ;_ end of if (if (= hidplt "1") (setq hdln "Yes") (setq hdln "No") ) ;_ end of if (if (= savdwg "1") (setq svqt "Yes") (setq svqt "No") ) ;_ end of if (if (= qitend "1") (setq qtdn "Yes") (setq qtdn "no") ) ;_ end of if ;;;First line written if just a script, Second line written if a plot script (setq str0 ".OPEN") (setq str01 "(if(eq(getvar\"dbmod\")0)(princ)\"Y\")") (if (eq "Limits" pltare) (progn (COND ((eq (substr (getvar "acadver") 1 2) "15") (setq str1 (strcat "(setq ftscl \"" pltscl "\" hdln \"" hdln "\")(load\"plbl\")(c:plbl)" ) ;_ end of strcat ;_ end of strcat str1a "-Plot\nYes\nLayout1\n8825.pc3\nARCH expand D (36.00 x 24.00 Inches)\nInches\nLandscape\nNo\nWindow" str2a "-Plot\nYes\nLayout1\n8825.pc3\nARCH expand B (18.00 x 12.00 Inches)\nInches\nLandscape\nNo\nWindow" ) ;_ end of setq (if (and (eq pltscl "Halfscale") (eq (substr plotr 1 5) "HP 4V") ) ;_ end of and (setq str2 "non (polar (getvar\"limmin\")0(*(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\"))0.49))" ) ;_ end of setq (setq str2 "non (getvar\"limmin\")") ;;; (setq str2 "(strcat(rtos(car(getvar\"limmin\"))2 2)\",\"(rtos(last(getvar\"limmin\"))2 2))") ) ;_ end of if (if (and (eq pltscl "Halfscale") (eq (substr plotr 1 5) "HP 4V") ) ;_ end of and (setq str3 "non (polar (getvar\"limmax\")pi(*(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\"))0.24))" ) ;_ end of setq (setq str3 "non (getvar\"limmax\")") ;;; (setq str3 "(strcat(rtos(car(getvar\"limmax\"))2 2)\",\"(rtos(last(getvar\"limmax\"))2 2))") ) ;_ end of if ) ((eq (substr (getvar "acadver") 1 2) "14") (setq str1 (strcat "(setq ftscl \"" pltscl "\" hdln \"" hdln "\")(load\"plbl\")(c:plbl)" ) ;_ end of strcat ;_ end of strcat str1a "Plot W" ) ;_ end of setq (if (and (eq pltscl "Halfscale") (eq (substr plotr 1 5) "HP 4V") ) ;_ end of and (setq str2 "non (polar (getvar\"limmin\")0(*(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\"))0.49))" ) ;_ end of setq (setq str2 "non (getvar\"limmin\")") ;;; (setq str2 "(strcat(rtos(car(getvar\"limmin\"))2 2)\",\"(rtos(last(getvar\"limmin\"))2 2))") ) ;_ end of if (if (and (eq pltscl "Halfscale") (eq (substr plotr 1 5) "HP 4V") ) ;_ end of and (setq str3 "non (polar (getvar\"limmax\")pi(*(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\"))0.24))" ) ;_ end of setq (setq str3 "non (getvar\"limmax\")") ;;; (setq str3 "(strcat(rtos(car(getvar\"limmax\"))2 2)\",\"(rtos(last(getvar\"limmax\"))2 2))") ) ;_ end of if ) ;progn ) ;_ end of COND ) ;_ end of progn (progn (setq str1 (strcat "(setq ftscl \"" pltscl "\" hdln \"" hdln "\")(load\"plbl\")(c:plbl)" ) ;_ end of strcat ;_ end of strcat ;_ end of strcat str1a "Zoom E" ) ;_ end of setq (setq str2 "PLOT") (setq str3 "E") ) ;progn ) ;if (setq fp1 (open (strcat pltdir lognm "BPLOT.SCR") "w")) (if (eq (substr (getvar "acadver") 1 2) "15") nil (if jstscr nil (setvar "plotid" plotr) ) ;_ end of if ) ;_ end of if (if (and plotr (wcmatch plotr "*8825*")) (progn (SETQ job_number (ureal 1 "" "Job Account.SubTask Number?" (IF job_number job_number nil ) ;_ end of IF ) ;_ end of ureal ) ;_ end of SETQ (setq job_account (itoa (fix job_number))) (setq job_subtask (strcat (substr (rtos (rem job_number (fix job_number))) 3 1) (if (zerop (atoi (substr (rtos (rem job_number (fix job_number))) 4 1) ) ;_ end of atoi ) ;_ end of zerop "" (substr (rtos (rem job_number (fix job_number))) 4 1) ) ;_ end of if (if (zerop (atoi (substr (rtos (rem job_number (fix job_number))) 5 1) ) ;_ end of atoi ) ;_ end of zerop "" (substr (rtos (rem job_number (fix job_number))) 5 1) ) ;_ end of if (if (zerop (atoi (substr (rtos (rem job_number (fix job_number))) 6 1) ) ;_ end of atoi ) ;_ end of zerop "" (substr (rtos (rem job_number (fix job_number))) 6 1) ) ;_ end of if ) ;_ end of strcat ) ;_ end of setq ) ;_ end of progn ) ;_ end of if (if (and (eq svqt "Yes") (/= (getvar "dwgname") "UNNAMED") (/= (getvar "dwgname") "DRAWING.DWG") (NOT (WCMATCH (getvar "dwgname") "DRAWING#.DWG")) ) ;_ end of and (c:qsave) ) ;if (princ (strcat "\nCreating " pltdir lognm "BPLOT.SCR, please wait... " ) ;_ end of strcat ) ;_ end of princ (setq waitic "|" ticsid 1 pltcnt 0 ) ;_ end of setq (foreach n pltlst (if (and (eq out_to "Fileout") (setq oldplt (findfile (strcat (substr n 1 (- (strlen n) 4)) ".PLT") ) ;_ end of findfile ) ;_ end of setq ) ;_ end of and (dos_delete (strcat (substr n 1 (- (strlen n) 4)) ".PLT")) ) ;_ end of if (setq pltcnt (1+ pltcnt)) (princ (strcat "\010" waitic)) (cond ((and (eq waitic "|") (eq ticsid 1)) (setq waitic "/")) ((eq waitic "/") (setq waitic "-" ticsid 2 ) ;_ end of setq ) ((eq waitic "-") (setq waitic "|")) ((and (eq waitic "|") (eq ticsid 2)) (setq waitic "\\")) ((eq waitic "\\") (setq waitic "|" ticsid 1 ) ;_ end of setq ) ) ;_ end of cond (if goplt (if (>= (- (strlen (getvar "dwgname")) (- (strlen n) 5)) 1) (if (eq n (strcat (getvar "dwgprefix") (getvar "dwgname")) ) ;_ end of eq nil (progn (if (eq (length pltlst) 1) (progn (princ n) (princ "\n") ) ;_ end of progn ) ;_ end of if (if jstscr nil ;;;first line written for plots (write-line (strcat "(if (and (> " (itoa (length pltlst)) " 1) c:sdsk)(xunload\"sdsk\"))" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ;_ end of if (write-line str0 fp1) (if (/= (getvar "dbmod") 0) ;;;Second line written if just a script, Third if a plot script ;;;Only written if drawing has been modified. ;;;Responds "Yes" to discard changes (write-line str01 fp1) ) ;if (if (wcmatch n "* *") (write-line (strcat "\"" n "\"") fp1) (write-line n fp1) ) ;_ end of if ) ;progn ) ;if (if (eq (strcase (strcat (getvar "dwgprefix") (if (wcmatch dwgn "*\\*") (while (wcmatch dwgn "*\\*") (setq dwgn (substr dwgn 2)) ) ;_ end of while dwgn ) ;_ end of if ; ".DWG" ) ;_ end of strcat ) ;_ end of strcase (strcase n) ) ;_ end of eq nil (progn (if jstscr nil (write-line (strcat "(if (and (> " (itoa (length pltlst)) " 1) c:sdsk)(xunload\"sdsk\"))" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ;_ end of if (write-line str0 fp1) (if (/= (getvar "dbmod") 0) (write-line str01 fp1) ) ;if (if (wcmatch n "* *") (write-line (strcat "\"" n "\"") fp1) (write-line n fp1) ) ;_ end of if ) ;progn ) ;_ end of if ) ;if (progn (if jstscr nil (write-line (strcat "(if (and (> " (itoa (length pltlst)) " 1) c:sdsk)(xunload\"sdsk\"))" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ;_ end of if (write-line str0 fp1) (write-line str01 fp1) (if (wcmatch n "* *") (write-line (strcat "\"" n "\"") fp1) ;;;Write filename to open (write-line n fp1) ) ;_ end of if ) ;progn ) ;if (if (and prestr (/= prestr "")) (if (eq (substr prestr 1 8) "filename") (progn (setq prefil (findfile (substr prestr 10))) (if prefil (progn (setq opref (open prefil "r")) (while (setq pflin (read-line opref)) ;;;Write contents of specified pre-plot script file (write-line pflin fp1) ) ;_ end of while (close opref) ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ;;;Or, Write contents of Bplot's pre-plot script edit box (write-line prestr fp1) ) ;_ end of if ) ;_ end of if (if jstscr nil ;;;Write lisp string for calculating drawing scale (write-line str1 fp1) ) ;_ end of if (if (not jstscr) (progn (write-line str1a fp1) ;Plot W (write-line str2 fp1) ;LIMMIN or calculated point for reduced scales (write-line str3 fp1) ;LIMMAX or calculated point for reduced scales (if (and open_ppf plt_param) (COND ((eq (substr (getvar "acadver") 1 2) "14") (write-line (strcat plt_param ;Before "write to file?" [plt_param = The first line of a PPF file] (if (eq out_to "Fileout") " Y " " N " ) ;_ end of if plt_para1 ;After "write to file?", Before "Size?" [plt_para1 = The second line of a PPF file] " (load\"pltsiz\")(pltsiz \"" pltare "\" \"" pltscl "\") !rotang " ;After "Rotation angle?" hdln ;After "Remove hidden lines?" ) ;_ end of strcat fp1 ) ;_ end of write-line (write-line (cond ((= pltscl "Fit") " FIT 0") ((= pltscl "Halfscale") "(/ 0.5(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\"))) 0" ;half-scale & proceed to plot ) ((= pltscl "FUllscale") "(/ 1.0(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\"))) 0" ;or, full-scale & proceed to plot ) ) ;_ end of cond fp1 ) ;_ end of write-line (if (eq out_to "Fileout") (write-line (strcat (if plt_para2 ;;;Answer to Autospool question (strcat plt_para2 " ") "" ) ;_ end of if (if (wcmatch n "* *") (strcat "\"" (substr n 1 (- (strlen n) 4)) "\"") (substr n 1 (- (strlen n) 4)) ) ;_ end of if ) ;_ end of strcat fp1 ) ;_ end of write-line ) ;_ end of if (if (and plotr (wcmatch plotr "*8825*")) (progn (write-line "0" fp1) (write-line job_account fp1) (write-line job_subtask fp1) (if plt_para3 (write-line plt_para3 fp1) ) ;_ end of if ) ;_ end of progn ) ;_ end of if (pst_scr) (COND ((>= (STRLEN plotr) 14) (write-line (strcat "(setq fstr \" " plotr " Plotted: \")(dlog)" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ((< (STRLEN plotr) 14) (SETQ pltdstr " Plotted") (WHILE (< (STRLEN (STRCAT " " plotr pltdstr ": \"")) 28) (SETQ pltdstr (STRCAT pltdstr ".")) ) ;_ end of WHILE (write-line (strcat "(setq fstr \" " plotr pltdstr ": \")(dlog)" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ) ;_ end of COND ) ((eq (substr (getvar "acadver") 1 2) "15") (write-line (cond ((= pltscl "Fit") " FIT 0") ((= pltscl "Halfscale") "(/ 0.5(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\")))" ;half-scale & proceed to plot ) ((= pltscl "FUllscale") "(/ 1.0(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\")))" ;or, full-scale & proceed to plot ) ) ;_ end of cond fp1 ) ;_ end of write-line (write-line (strcat ;;; " (load\"pltsiz\")(pltsiz \"" ;;; pltare ;;; "\" \"" ;;; pltscl ;;; "\")" ;After "Scale?" ;;; (WRITE-LINE "-0.35,0" fp1) ;;; (WRITE-LINE "Yes" fp1) ;;; (WRITE-LINE "cmud.ctb" fp1) ;;; (WRITE-LINE "Yes" fp1) ;;; (WRITE-LINE "No" fp1) ;;; (WRITE-LINE "No" fp1) ;;; plt_param ;Before "write to file?" [plt_param = The first line of a PPF file] (IF (WCMATCH n "*\\1363\\*") "-0.35,0\nYes\ncmud.ctb\nYes\nNo\nNo" "-0.35,0\nYes\ncdm_std.ctb\nYes\nNo\nNo" ) "\n" hdln "\n" ;;; (WRITE-LINE hdln fp1) ;After "Remove hidden lines?" ;;; (WRITE-LINE (if (eq out_to "Fileout") "Yes" "No" ) ;_ end of if ;;; fp1 ;;; ) ;;; plt_para1 ;After "write to file?", Before "Size?" [plt_para1 = The second line of a PPF file] ) ;_ end of strcat fp1 ) ;_ end of write-line (if (eq out_to "Fileout") (write-line (strcat ;;; (if plt_para2 ;;;;;;Answer to Autospool question ;;; (strcat plt_para2 " ") ;;; "" ;;; ) ;_ end of if (if (wcmatch n "* *") (strcat "\"" (substr n 1 (- (strlen n) 4)) "\"") (substr n 1 (- (strlen n) 4)) ) ;_ end of if "\nNo\nYes" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ;_ end of if (if (and plotr (wcmatch plotr "*8825*") (eq (substr (getvar "acadver") 1 2) "14") ) ;_ end of and (progn (write-line "0" fp1) (write-line job_account fp1) (write-line job_subtask fp1) (if plt_para3 (write-line plt_para3 fp1) ) ;_ end of if ) ;_ end of progn ) ;_ end of if ;;;******************************************************************************** (write-line str2a fp1) (write-line str2 fp1) ;LIMMIN or calculated point for reduced scales (write-line str3 fp1) ;LIMMAX or calculated point for reduced scales (write-line "(/ 0.5(if(eq(getvar\"dimscale\")0)1(getvar\"dimscale\")))" fp1 ) ;_ end of write-line (write-line (strcat (IF (WCMATCH n "*\\1363\\*") "-0.175,0\nYes\ncmud_half.ctb\nYes\nNo\nNo" "-0.175,0\nYes\ncdm_half.ctb\nYes\nNo\nNo" ) "\n" hdln "\n" (if (eq out_to "Fileout") "Yes" "No" ) ;_ end of if ) ;_ end of strcat fp1 ) ;_ end of write-line (if (eq out_to "Fileout") (progn (setq this_n (dos_splitpath n)) ;;; (princ "\nthis_n=") ;;; (princ this_n) ;;; (princ) (dos_mkdir (strcat "\"" "D:" (cadr this_n)"Plots\\Half\\""\"")) (write-line (strcat (if (wcmatch n "* *") (strcat "\"" "D:" (substr (cadr this_n)1(-(strlen(cadr this_n))5))"Plots\\Half\\"(caddr this_n)".plt\"") (strcat "D:" (substr (cadr this_n)1(-(strlen(cadr this_n))5))"Plots\\Half\\"(caddr this_n)".plt") ) ;_ end of if "\nNo\nYes" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ) ;_ end of if (COND ((>= (STRLEN plotr) 14) (write-line (strcat "(setq fstr \" " plotr " Plotted: \")(dlog)" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ((< (STRLEN plotr) 14) (SETQ pltdstr " Plotted") (WHILE (< (STRLEN (STRCAT " " plotr pltdstr ": \"")) 28) (SETQ pltdstr (STRCAT pltdstr ".")) ) ;_ end of WHILE (write-line (strcat "(setq fstr \" " plotr pltdstr ": \")(dlog)" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ) ;_ end of COND ;;;******************************************************************************** (pst_scr) (COND ((>= (STRLEN plotr) 14) (write-line (strcat "(setq fstr \" " plotr " Plotted: \")(dlog)" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ((< (STRLEN plotr) 14) (SETQ pltdstr " Plotted") (WHILE (< (STRLEN (STRCAT " " plotr pltdstr ": \"")) 28) (SETQ pltdstr (STRCAT pltdstr ".")) ) ;_ end of WHILE (write-line (strcat "(setq fstr \" " plotr pltdstr ": \")(dlog)" ) ;_ end of strcat fp1 ) ;_ end of write-line ) ) ;_ end of COND ) ) ;_ end of COND ) ;_ end of if ) ;_ end of progn (pst_scr) ) ;_ end of if (setq goplt nil) ) ;_ end of foreach (if (= pltcnt 1) (princ (strcat "\010Done! Ready to plot " (nth 0 pltlst) ". ") ) ;_ end of princ (princ (strcat "\010Done! Ready to plot " (itoa pltcnt) " drawings. " ) ;_ end of strcat ) ;_ end of princ ) ;_ end of if (if (eq qtdn "Yes") (write-line "QUIT Y" fp1) (if (eq (length pltlst) 1) (write-line "(if ent(entdel(ssname ent 0)))" fp1) (if (or (eq (strcat cdwg ".DWG") (findfile (last pltlst))) (eq cdwg (findfile (last pltlst))) (eq (substr cdwg (- (strlen cdwg) 6)) "UNNAMED") ) ;_ end of or (progn (write-line "(if ent(entdel(ssname ent 0)))" fp1) ) ;_ end of progn (progn (write-line "(if ent(entdel(ssname ent 0)))" fp1) (write-line ".OPEN" fp1) (write-line "(if(eq(getvar\"dbmod\")0)(princ)\"Y\")" fp1) (if (wcmatch (strcase cdwg) "*.DWG") (write-line (strcat "\"" cdwg "\"") fp1) (write-line (strcat "\"" cdwg ".DWG\"") fp1) ) ;_ end of if ) ;_ end of progn ) ;_ end of if ) ;_ end of if ) ;if (if fp1 (close fp1) ) ;_ end of if (setq scrnm (strcat pltdir lognm "BPLOT")) (if ukword nil (load "ukword") ) ;_ end of if (setq scrnow (ukword 1 "Yes No" (strcat "Begin batch plot script \"" scrnm ".SCR\" now? (Yes or No)" ) ;_ end of strcat (if scrnow scrnow "Yes" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq (if (and plotr (wcmatch plotr "*8825*") (eq out_to "Fileout")) (write-xds) ) ;_ end of if (if (and scrnm (eq scrnow "Yes")) (command "_.script" scrnm) (progn (rstdir) (princ (strcat "\nUse the SCRIPT command to run " scrnm ".SCR when ready." ) ;_ end of strcat ) ;_ end of princ ) ;_ end of progn ) ;_ end of if (setvar "expert" 0) (setvar "filedia" 1) (setvar "osmode" osmod) (graphscr) (setq *error* bplot_olderr) (setvar "luprec" old_luprec) (princ) ) ;defun (defun pst_scr () (if (and pststr (/= pststr "")) (if (eq (substr pststr 1 8) "filename") (progn (setq pstfil (findfile (substr pststr 10))) (if pstfil (progn (setq opstf (open pstfil "r")) (while (setq pflin (read-line opstf)) (write-line pflin fp1) ) ;_ end of while (close opstf) ) ;_ end of progn ) ;_ end of if ) ;_ end of progn (write-line pststr fp1) ) ;_ end of if ) ;_ end of if ) ;_ end of defun (DEFUN WRITE-XDS (/) (IF (AND (SETQ XDS-FILE (OPEN (STRCAT (SUBSTR (NTH 0 pltlst) 1 (- (STRLEN (NTH 0 pltlst)) 4)) ".xds" ) ;_ end of STRCAT "w" ) ;_ end of OPEN ) ;_ end of SETQ pltlst job_number ) ;_ end of AND (PROGN (WRITE-LINE "[JOB]" xds-file) (WRITE-LINE "VERSION=4" xds-file) (WRITE-LINE (STRCAT "NAME=" (SUBSTR (NTH 0 pltlst) 1 (- (STRLEN (NTH 0 pltlst)) 4)) ".plt" ) ;_ end of strcat xds-file ) ;_ end of write-line (WRITE-LINE (STRCAT "ACCOUNT=" (RTOS job_number 2 1)) xds-file ) ;_ end of WRITE-LINE (WRITE-LINE "COPIES=1" xds-file) (WRITE-LINE "PRIORITY=5" xds-file) (WRITE-LINE "COLLATION=TRUE" xds-file) (WRITE-LINE "BANNER=FALSE" xds-file) (WRITE-LINE "MEDIAMISMATCH=SCALE" xds-file) (WRITE-LINE "PLOTNESTING=OFF" xds-file) (WRITE-LINE "PAGECOMPENABLE=FALSE" xds-file) (WRITE-LINE "PAGECOMPPAPER=ANSI_E" xds-file) (WRITE-LINE "PAGECOMPMEDIATYPE=ANY" xds-file) (WRITE-LINE "PAGECOMPMEDIASOURCE=AUTO" xds-file) (WRITE-LINE "FOLDER=BYPASS" xds-file) (WRITE-LINE "FOLDING=BYPASS" xds-file) (WRITE-LINE (STRCAT "FILECOUNT=" (RTOS (LENGTH pltlst) 2 0)) xds-file ) ;_ end of WRITE-LINE (WRITE-LINE "" xds-file) (WRITE-LINE "[LABEL]" xds-file) (WRITE-LINE "LABELUSED=FALSE" xds-file) (WRITE-LINE "LABELSTRING=" xds-file) (WRITE-LINE "LABELFONT=HP Stick Font" xds-file) (WRITE-LINE "LABELSIZE=14" xds-file) (WRITE-LINE "LABELROTATE=90" xds-file) (WRITE-LINE "LABELSHADING=100" xds-file) (WRITE-LINE "LABELLOCX=TRAILING" xds-file) (WRITE-LINE "LABELABSX=0.0000" xds-file) (WRITE-LINE "LABELLOCY=BOTTOM" xds-file) (WRITE-LINE "LABELABSY=0.0000" xds-file) (WRITE-LINE "LABELUNITS=INCH" xds-file) (WRITE-LINE "" xds-file) (WRITE-LINE "[STAMP]" xds-file) (WRITE-LINE "VERSION=1" xds-file) (WRITE-LINE "STAMPUSED=FALSE" xds-file) (WRITE-LINE "RASTERID=" xds-file) (WRITE-LINE "RASTERSCALEMODE=RELATIVE" xds-file) (WRITE-LINE "RASTERSCALING=100" xds-file) (WRITE-LINE "RASTERROTATE=90" xds-file) (WRITE-LINE "RASTERLOCX=CENTER" xds-file) (WRITE-LINE "RASTERABSX=0.0000" xds-file) (WRITE-LINE "RASTERLOCY=CENTER" xds-file) (WRITE-LINE "RASTERABSY=0.0000" xds-file) (WRITE-LINE "STAMPUNITS=INCH" xds-file) (WRITE-LINE "" xds-file) (SETQ pltcnt 0) (FOREACH n pltlst (WRITE-LINE (STRCAT "[FILE" (COND ((EQ pltcnt 0) "000") ((< pltcnt 10) (STRCAT "00" (ITOA pltcnt))) ((< pltcnt 100) (STRCAT "0" (ITOA pltcnt))) ((< pltcnt 1000) (ITOA pltcnt)) ) ;_ end of COND "]" ) ;_ end of strcat xds-file ) ;_ end of write-line (WRITE-LINE "VERSION=3" xds-file) (WRITE-LINE (STRCAT "FILEPATH=" (SUBSTR (NTH pltcnt pltlst) 1 (- (STRLEN (NTH pltcnt pltlst)) 4) ) ;_ end of substr ".plt" ) ;_ end of strcat xds-file ) ;_ end of write-line (WRITE-LINE "PDL=AUTO" xds-file) (WRITE-LINE "MEDIASOURCE=AUTO" xds-file) (WRITE-LINE "MEDIASIZE=ANY" xds-file) (WRITE-LINE "MEDIATYPE=PAPER" xds-file) (WRITE-LINE "SCALINGTYPE=DISABLED" xds-file) (WRITE-LINE "SCALINGPERCENT=100" xds-file) (WRITE-LINE "AUTOROTATE=TRUE" xds-file) (WRITE-LINE "ROTATION=0" xds-file) (WRITE-LINE "JUSTTYPEX=CENTER" xds-file) (WRITE-LINE "JUSTDISTX=0.0000" xds-file) (WRITE-LINE "JUSTTYPEY=CENTER" xds-file) (WRITE-LINE "JUSTDISTY=0.0000" xds-file) (WRITE-LINE "JUSTUNITS=INCH" xds-file) (WRITE-LINE "MIRRORX=FALSE" xds-file) (WRITE-LINE "MIRRORY=FALSE" xds-file) (WRITE-LINE "" xds-file) (WRITE-LINE (STRCAT "[LABEL" (COND ((EQ pltcnt 0) "000") ((< pltcnt 10) (STRCAT "00" (ITOA pltcnt))) ((< pltcnt 100) (STRCAT "0" (ITOA pltcnt))) ((< pltcnt 1000) (ITOA pltcnt)) ) ;_ end of COND "]" ) ;_ end of strcat xds-file ) ;_ end of write-line (WRITE-LINE "LABELUSED=FALSE" xds-file) (WRITE-LINE "LABELSTRING=" xds-file) (WRITE-LINE "LABELFONT=HP Stick Font" xds-file) (WRITE-LINE "LABELSIZE=14" xds-file) (WRITE-LINE "LABELROTATE=90" xds-file) (WRITE-LINE "LABELSHADING=100" xds-file) (WRITE-LINE "LABELLOCX=TRAILING" xds-file) (WRITE-LINE "LABELABSX=0.0000" xds-file) (WRITE-LINE "LABELLOCY=BOTTOM" xds-file) (WRITE-LINE "LABELABSY=0.0000" xds-file) (WRITE-LINE "LABELUNITS=INCH" xds-file) (WRITE-LINE "" xds-file) (WRITE-LINE (STRCAT "[STAMP" (COND ((EQ pltcnt 0) "000") ((< pltcnt 10) (STRCAT "00" (ITOA pltcnt))) ((< pltcnt 100) (STRCAT "0" (ITOA pltcnt))) ((< pltcnt 1000) (ITOA pltcnt)) ) ;_ end of COND "]" ) ;_ end of strcat xds-file ) ;_ end of write-line (WRITE-LINE "VERSION=1" xds-file) (WRITE-LINE "STAMPUSED=FALSE" xds-file) (WRITE-LINE "RASTERID=" xds-file) (WRITE-LINE "RASTERSCALEMODE=RELATIVE" xds-file) (WRITE-LINE "RASTERSCALING=100" xds-file) (WRITE-LINE "RASTERROTATE=90" xds-file) (WRITE-LINE "RASTERLOCX=CENTER" xds-file) (WRITE-LINE "RASTERABSX=0.0000" xds-file) (WRITE-LINE "RASTERLOCY=CENTER" xds-file) (WRITE-LINE "RASTERABSY=0.0000" xds-file) (WRITE-LINE "STAMPUNITS=INCH" xds-file) (WRITE-LINE "" xds-file) (WRITE-LINE (STRCAT "[PAGECOMP" (COND ((EQ pltcnt 0) "000") ((< pltcnt 10) (STRCAT "00" (ITOA pltcnt))) ((< pltcnt 100) (STRCAT "0" (ITOA pltcnt))) ((< pltcnt 1000) (ITOA pltcnt)) ) ;_ end of COND "]" ) ;_ end of strcat xds-file ) ;_ end of write-line (WRITE-LINE "VERSION=1" xds-file) (WRITE-LINE "PAGECOMPSIZE=ANY" xds-file) (WRITE-LINE "PAGECOMPSCALE=FALSE" xds-file) (WRITE-LINE "PAGECOMPROTATE=0" xds-file) (WRITE-LINE "PAGECOMPPOSX=0.0000" xds-file) (WRITE-LINE "PAGECOMPPOSY=0.0000" xds-file) (WRITE-LINE "PAGECOMPUNITS=INCH" xds-file) (WRITE-LINE "" xds-file) (SETQ pltcnt (1+ pltcnt)) ) ;_ end of foreach (CLOSE xds-file) (PRINC (STRCAT "\nXDS File " (SUBSTR (NTH 0 pltlst) 1 (- (STRLEN (NTH 0 pltlst)) 4)) ".xds created! " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN (PRINC "\nUnable to create XDS file! ") ) ;_ end of IF (princ) ) ;_ end of DEFUN (princ) (defun c:itt () (setq layList (dictsearch (namedobjdict) "ACAD_LAYOUT")) (setq Index 0) (while (and (/= (cdr (nth Index layList)) "Layout1") (/= (nth Index layList) nil) ) ;_ end of and (setq Index (+ Index 1)) (if (nth (+ Index 1) layList) (setq modelList (entget (cdr (nth (+ Index 1) layList)))) ) ;_ end of if ) ;_ end of while ) ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 0 0 0 T T nil T) ***Don't add text below the comment!***|;