;SHIP.LSP program to prepare drawings to be shipped out in conformance
;to the receiving party's requirements.
;
;Released into the public domain the the author, Sierra Hermitage
;
;Sierra Hermitage
;Rod Young, programmer
;140 Mesa Vista Drive
;Bishop, CA  93514
;Phone 619-387-2479 (voice)   619-387-2488 (data/fax, seldom enabled)
;E-mail hermit1@ix.netcom.com

;Please read the following documentation prior to running this program.
;
;It can be both inconvenient and embarrassing to ship drawings to clients
;or colleagues that they can not load or that are confusing to an operator
;who is not familiar with your layering convention, fonts, menus and
;system variable settings.  SHIP.LSP prepares your drawings for shipping
;by resolving many of these issues.  

;This can be the result of a number of things:
;
;		You use a layer name conventions different than the other party.
;
;		You use font files that are proprietary and the other party
;		doesn't have, or use, them.
;
;		Your fonts are not compatible with the other party's graphic style.
;
;		Your system variable are set different than the other party's normal
;		settings.
;		
;		Your drawings use external references that were not included in the
;		shipping.

;Many of these same issues apply to drawings that are shipped TO you,
;in which case, you will want the other party to use this program.

;SHIP.LSP in intended to be used with RUN LISP (see RUNLISP.TXT) to
;automatically batch process multiple drawing.  However, it can be used
;on one drawing at a time, or on multiple drawings by using a script file.
;Scripts are a pain to prepare so save yourself lots of time and order
;RUN LISP today.  It will probably pay for itself the first time you use it
;and it provides the key to other AutoCad automation.  If you don't use
;RUN LISP, you may need to rework the last few lines of the main program
;where the save drawing path is built.  When using RUN LISP the drawing
;name (getvar "dwgname") is the full path but a script or manual use of
;this program will probably require that you concatenate the path and
;name.
;
;Other RUN LISP compatible programs that come with RUN LISP.
;	
;		AUTOPURG.LSP	purges unused layers, styles, blocks, etc
;
;		AUTOPLOT.LSP	plots to plot files
;
;		FONTSUB.LSP		substitutes fonts
;
;		ASLDLIB.LSP		creates slides of drawing and SLIDELIB.EXE compatible
;							input file for creating slide libraries
;		ABKOUT.LSP		wblocks out all blocks within a drawing - use with
;							ASLDLIB.LSP to create slide libraries of your block
;							and/or build ICON menu entries.									
;
;All of the above programs can be used with RUN LISP to batch process
;multiple drawings automatically in unattended mode.  Plus, RUN LISP will 
;work with any other autolisp program that is suitable for batch processing,
;without the need to prepare script files.  That means that you can easily
;batch process drawings to create dxf files, renderings, data extraction files,
;you name it.  You can also automate drawing maintenance easily.
;
;See RUNLISP.TXT for other AutoCad automation programs available from
;Sierra Hermitage, including automations that cannot be done from AutoLisp
;alone (even with script files) - such as plotting directly to printer/plotter 
;and converting R13 to R12.

RUNNING THE PROGRAM:

;This program sets both systems variables CMDDIA and FILEDIA to zero.  You
;must restore those values manually after running the program.  Before
;running the program you should check to see what your normal settings
;for those variables are by typing the variable name at the command line.

;YOU MUST create a directory off of the directory containing the drawings
;named SHIP prior to running this program.  The drawings to be shipped are
;put in that directory and your original drawings are unaltered.

;SHIP.LSP has multiple functions, some of which require that an input file
;be supplied by you.  Most of these files will apply to all drawings that
;you may ship, so once prepared they can be reused.  If you do not want
;to enable a particular function, don't furnish the required text file, but
;be sure there isn't an old one still hanging around.


;**FONT SUBSTITION**

;If you wish to substitute fonts, create a text file with one line for each 
;font substitution in the following format:
;
;oldfont newfont factor
;
;Omit 'factor' if there is no size difference between the two
;fonts.  Factor is the ratio of the old to the new.  One space
;only between oldfont,newfont and factor.
;
;Name this text file FONTSUB.TXT and place it in the same
;directory as the drawings to be changed.
;
;Because changing fonts can result in problems if the font sizes
;are different, keep your old drawings until you are sure that 
;all is well. This program will save the new drawings in a 
;subdirectory called SHIP off of the directory containing the 
;old drawings. YOU MUST CREATE THAT DIRECTORY prior to running 
;this program.
;
;**LAYER RENAMING**

;If you wish to rename layers to conform to your client or college's 
;requirements, you must supply a text file of those settings in the following
;format:
;
;oldlayername1 newlayername1
;oldlayername2 newlayername2
;...
;
;ie:
;rr railroad
;txt text
;
;just one space between
;This file must be named LAYER.TXT and be in the same directory as the
;drawings
;
;***EXTERNAL REFERENCES***

;SHIP.LSP automatically binds all attached references and detaches all
;overlay and unresolved references.  If you plan to ship the external
;references and don't want this feature enabled, delete the lines in
;this program between the xxxBEGIN EXTERNAL REFERENCE ROUTINExxx and
;the xxxEND EXTERNAL REFERENCE ROUTINExxx.  Please note that the FONTSUB
;function will not apply to external reference styles in external references
;that are not bound.  Also, please note that unresolved references will not
;be detached if they are currently inserted into the drawing.

;***ZOOM EXTENTS***

;SHIP.LSP automatically zooms to extents.
;

;***SYSTEM VARIABLES***

;The supplied file, SYSVAR.TXT, is an input file to change system variables
;saved in the drawing to the most common setting for those variables.  It
;must be in the same directory as the drawing.  You are free to add additional
;variables, or change the values, but be sure that variables are ones that
;are saved in the drawing (or you'll end up changing your own variables that
;are saved in the acad.cfg file).
;
;sysvar1 setting1
;sysvar2 setting2
;...
;
;ie:
;cecolor bylayer
;celtype continuous
;...
;
;just one space between
;
;This file must be named SYSVAR.TXT and be in the same directory as the
;drawings. 
;
;The following is a list of system variables saved in the drawing together
;with the most common settings:

;ATTDIA 1
;BLIPMODE ON
;CECOLOR BYLAYER
;CELTYPE BYLAYER
;COORDS 0
;DRAGMODE AUTO
;FILLMODE 1
;LIMCHECK 0
;PLINEWID 0
;QTEXTMODE 0
;REGENMODE 1
;THICKNESS 0
;UCSICON ON

;Please note that the values are those that you would type at the command
;line and not those that you would use with SETVAR.

;***END OF DOCUMENTATION***
;

;*** sub to change font table & text entities ***

(defun fixfont()
   ;check for attached xref style
   (setq chrcount 1)
   (setq flag nil)
   (repeat (strlen stylename)
      (if (= (substr stylename chrcount 1) "|")(setq flag t))
      (setq chrcount (1+ chrcount))
   );end repeat
   (if (not flag);can't fix xref styles
      (progn
         ;first fix the table - can't use entmod on table
         (command "style" stylename newfont (* ht factor) "" "" "" "" "" )
         ;if factor is not 1 then individual text entities height must be changed
         (if (/= factor 1.0)
            (progn
               (if (not ss);get all text entities - if not done previously
                  (setq ss(ssget "X" '((0 . "TEXT"))))
               );end if
               (setq count 0)
               ;check all existing text entities
               (if ss;if there is text in the drawing
                  (progn
                     (repeat (sslength ss)
                        (setq entlist(entget(ssname ss count)))
                        (if (= (cdr(assoc 7 entlist)) stylename);if style is to be substituted
                           ;change it
                           (progn
                              (setq oldht(cdr(assoc 40 entlist)))
                              (setq newht(* oldht factor))
                              (setq entlist
                                 (subst (cons 40 newht)
                                    (assoc 40 entlist)
                                 entlist)
                              );end setq
                              (entmod entlist)
                           );end progn
                        );end if the right one
                        (setq count (1+ count))
                     );end repeat
                  ));end progn & if
               );end progn for 0 height
            );end if 0 height
         ));end progn and if
      );end fixfont sub defun
      
      ;*** sub to bind/detach external references ***
      
      ;dxf 64 - unresolved external reference - not inserted
      ;dxf 68 - unresolved external reference - inserted
      ;dxf 76 - unresolved external overlay
      ;dxf 100 - resolved external reference
      ;dxf 108 - resolved external overlay
      
      (defun fixblk()
         (setq dxfcode(cdr(assoc 70 blklist)))
         (if (or (= dxfcode 64)(= dxfcode 68)(= dxfcode 76));unresolved reference
            (command "xref" "detach" (cdr(assoc 2 blklist)))
         );end if
         (if (= dxfcode 100);resolved attached reference
            (command "xref" "bind" (cdr(assoc 2 blklist)))
         );end if
         (if (= dxfcode 108);resolved overlay reference
            (command "xref" "detach" (cdr(assoc 2 blklist)))
         );end if
      );end defun
      
      *** MAIN PROGRAM ***
      
      (defun ship()
         ;set acad as menu
         ;         (command "menu" "acad")
         ;zoom to extents
         (if (/= (getvar "viewmode") 1) ;can't zoome in prespective
            (command "zoom" "e")
         );end if
         
         ;xxxBEGIN EXTERNAL REFERENCE ROUTINExxx
         ;fix external references
         ;bind attached references
         ;detach overlay references
         (setq blklist(tblnext "block" t));wind the table and get file block
         (fixblk);send to subroutine
         (while (setq blklist(tblnext "block"));get the other blocks
            (fixblk);send to subroutine
         );end while
         ;xxxEND EXTERNAL REFERENCE ROUTINExxx
         
         ;if user supplies sysvar file - set them
         (if (setq ifile(open "SYSVAR.TXT" "r"))
            (progn
               (while (setq inline(read-line ifile))
                  (setq count 1)
                  (while (/= (substr inline count 1) " ")
                     (setq sysvar (substr inline 1 count))
                     (setq count(1+ count))
                  );end while
                  (setq count (+ 1 count))
                  (setq newval(substr inline count))
                  ;check if newval is number
                  (setq chrcount 1)
                  (setq flag nil)
                  (repeat (strlen newval)
                     (if (or(< (ascii(substr newval chrcount 1))48)(> (ascii(substr newval chrcount 1))57))(setq flag t))
                     (setq chrcount (1+ chrcount))
                  );end repeat
                  (if (not flag);can be number	
                     (setq newval (atoi newval))
                  );end if
                  ;now change sys var - use command as some setvar alisp don't accept newval
                  (command sysvar newval)
               );end while
               (close ifile)
            );end progn
         );end if
         ;if user supplies font substitution file - make substitions
         (if (setq ifile(open "FONTSUB.TXT" "r"));if user created the file
            (progn
               (setq ss nil)
               (while
                  (setq inline(read-line ifile))
                  (setq count 1)
                  (while (/= (substr inline count 1) " ")
                     (setq oldfont(strcase(substr inline 1 count)T))
                     (setq count(1+ count))
                  );end while
                  (setq count (+ 1 count)
                  mark count)
                  (while (and (<= count (strlen inline))(/= (substr inline count 1) " "))
                     (setq newfont(strcase(substr inline mark (1+(- count mark)))T))
                     (setq count(1+ count))
                  );end while
                  (if (> (strlen inline) count)
                     (setq factor(atof(substr inline count)))
                     (setq factor 1)
                  );end if
                  (setq stylist(tblnext "STYLE" T))              ;rewind table and get first style
                  (setq font(cdr(assoc 3 stylist)))             ;what style is it
                  (if (= font oldfont)                         ;if it is the right one
                     (progn
                        (setq ht(cdr(assoc 40 stylist)))             ;get height info
                        (setq stylename(cdr(assoc 2 stylist)))
                        (fixfont);call sub to fix it
                     );end progn
                  );if
                  (while (setq stylist(tblnext "STYLE"))         ;get the rest of them
                     (setq font(cdr(assoc 3 stylist)))        ;and their style
                     (if (= font oldfont)                      ;if the right one
                        (progn
                           (setq ht(cdr(assoc 40 stylist))) ;get its height
                           (setq stylename(cdr(assoc 2 stylist)))
                           (fixfont)
                        );end progn
                     );if   	
                  );end while
               );end while reading file
            );end progn for file found
         );end if font substition file found
         (close ifile)
         ;if user supplies layer file - rename layers
         (if (setq ifile(open "LAYER.TXT" "r"))
            (progn
               (while (setq inline(read-line ifile))
                  (setq count 1)
                  (while (/= (substr inline count 1) " ")
                     (setq oldlayer(strcase(substr inline 1 count)))
                     (setq count(1+ count))
                  );end while
                  (setq count (+ 1 count))
                  (setq newlayer(strcase(substr inline count)))
                  (setq laylist(tblnext "LAYER" t))
                  (setq layname(cdr(assoc 2 laylist)))
                  (if (= oldlayer layname)(command "rename" "layer" layname newlayer))
                  (while(setq laylist(tblnext "LAYER"))
                     (setq layname(cdr(assoc 2 laylist)))
                     (if (= oldlayer layname)(command "rename" "layer" layname newlayer))
                  );end while
               );end while
               (close ifile)
            );end progn
         );end if
         (setq ss nil) ;free the selection set
         ;build save drawing path
         (setq cname(getvar "dwgname"))
         (setq count 1)
         (repeat (strlen cname)
            (if (= (substr cname count 1) (chr 92))
               (setq mark (1- count))
            );end if
            (setq count (1+ count))
         );end repeat
         ;add SHIP subdirectory to build save drawing path
         ;If you are using this program manually or with a script, see the documentation
         ;near the beginning of this file regarding the save drawing path.
         ;If you are using RUN LISP - 'no problem'
         (setq nname(strcat (substr cname 1 mark) (chr 92) "SHIP" (chr 92) (substr cname (+ 2 mark))))
         ;check if drawing exists in SHIP directory - if so, overwrite it
         (if (= (findfile (strcat nname ".DWG")) (strcat nname ".DWG"))
            (command "saveas" nname "y" )
            (command "saveas" nname )
         );end if
         (command)
      );end defun  
      ;make this program 'load & go' - do this for all RUN LISP compatible programs.
      (ship)
      
      
      