;-------------------------------------------------------------------------------
; Program Name: Scrs - Script Creator [Scrs R3]
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
;               (URL: http://web2.airmail.net/terrycad)
; Date Created: 4-20-04
; Function:     Runs script on a drawing or drawings or dxfs in a folder
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM   4-20-04   Initial version
; 2    TM   9-20-06   Revised and added new subfunctions
; 3    TM  11-20-07   Added GetLayoutList, ZoomE and Purged functions
;-------------------------------------------------------------------------------
; c:Scrs - Script Creator
;-------------------------------------------------------------------------------
(defun c:Scrs (/ Dcl_Id% DwgName$ DxfName$ FileName% First FolderDwgs@ FolderDxfs@
  Index# Item Loop Option PathFilename$ Return# Set_Vars: Var0$ Var1$ Var2$ Var3$
  Var4$ Var5$ Var6$)
  (if (> (length (GetDwgsList)) 1)
    (alert (strcat "The Script Options for Folders can only be run\n"
      "in a Single Document Interface.  For this option\n"
      "close all other open drawings and try again.")
    );alert
  );if
  ;-----------------------------------------------------------------------------
  ; Set_Vars: - Set dialog tiles and variables
  ;-----------------------------------------------------------------------------
  (defun Set_Vars: (VarName$)
    (set (read VarName$) $value)
    (if (and (/= Var2$ "") (/= Var3$ "") (/= Var4$ "") (/= Var5$ "")(/= Var6$ ""))
      (mode_tile "Next" 0)
      (mode_tile "Next" 1)
    );if
    (set_tile "Toggle0" Var0$)
    (if (= Var0$ "1")
      (progn
        (setq Var0$ "0")
        (setq Var2$ "" Var3$ "" Var4$ "" Var5$ "" Var6$ "" Index# 0)
        (setq *Script@ (list Var1$ Var2$ Var3$ Var4$ Var5$ Var6$))
        (set_tile "Text1" (strcat "Page " (itoa (/ (+ Index# 5) 5)) " of " (itoa (/ (length *Script@) 5))))
        (set_tile "Edit2" Var2$)
        (set_tile "Edit3" Var3$)
        (set_tile "Edit4" Var4$)
        (set_tile "Edit5" Var5$)
        (set_tile "Edit6" Var6$)
        (mode_tile "Back" 1)
        (mode_tile "Next" 1)
      );progn
    );if
  );defun Set_Vars:
  ;-----------------------------------------------------------------------------
  ; Set Default Variables and List Values
  ;-----------------------------------------------------------------------------
  (if (= (length (GetDwgsList)) 1)
    (setq Option "2")
    (setq Option "1")
  );if
  (if (not *Script@)
    (setq *Script@ (list Option "" "" "" "" ""))
  );if
  (setq Var0$ "0"
        Var1$ (nth 0 *Script@)
        Var2$ (nth 1 *Script@)
        Var3$ (nth 2 *Script@)
        Var4$ (nth 3 *Script@)
        Var5$ (nth 4 *Script@)
        Var6$ (nth 5 *Script@)
        Loop t
        Index# 0
  );setq
  ;-----------------------------------------------------------------------------
  ; Load Dialog
  ;-----------------------------------------------------------------------------
  (while Loop
    (if (= (length *Script@)(1+ Index#))
      (setq *Script@ (append *Script@ (list "" "" "" "" "")))
    );if
    (setq Var1$ (nth 0 *Script@)
          Var2$ (nth (+ Index# 1) *Script@)
          Var3$ (nth (+ Index# 2) *Script@)
          Var4$ (nth (+ Index# 3) *Script@)
          Var5$ (nth (+ Index# 4) *Script@)
          Var6$ (nth (+ Index# 5) *Script@)
    );setq
    (setq Dcl_Id% (load_dialog "Scrs.dcl"))
    (new_dialog "Scrs" Dcl_Id%)
    ;---------------------------------------------------------------------------
    ; Set Dialog Initial Settings
    ;---------------------------------------------------------------------------
    (set_tile "Title" " Script Creator")
    (set_tile "Radio1" Var1$)
    (set_tile "Text1" (strcat "Page " (itoa (/ (+ Index# 5) 5)) " of " (itoa (/ (length *Script@) 5))))
    (set_tile "Edit2" Var2$)
    (set_tile "Edit3" Var3$)
    (set_tile "Edit4" Var4$)
    (set_tile "Edit5" Var5$)
    (set_tile "Edit6" Var6$)
    (if (= Index# 0)
      (mode_tile "Back" 1)
    );if
    (if (and (= Var2$ "") (= Var3$ "") (= Var4$ "") (= Var5$ "")(= Var6$ ""))
      (mode_tile "Next" 1)
    );if
    (if (> (length (GetDwgsList)) 1)
      (progn
        (mode_tile "2" 1)
        (mode_tile "3" 1)
      );progn
    );if
    ;---------------------------------------------------------------------------
    ; Dialog Actions
    ;---------------------------------------------------------------------------
    (action_tile "Toggle0" "(Set_Vars: \"Var0$\")")
    (action_tile "Radio1"  "(Set_Vars: \"Var1$\")")
    (action_tile "Edit2"   "(Set_Vars: \"Var2$\")")
    (action_tile "Edit3"   "(Set_Vars: \"Var3$\")")
    (action_tile "Edit4"   "(Set_Vars: \"Var4$\")")
    (action_tile "Edit5"   "(Set_Vars: \"Var5$\")")
    (action_tile "Edit6"   "(Set_Vars: \"Var6$\")")
    (action_tile "Back"    "(done_dialog 2)")
    (action_tile "Next"    "(done_dialog 3)")
    (setq Return# (start_dialog))
    (unload_dialog Dcl_Id%)
    (if (= Return# 0)
      (exit)
    );if
    (if (= Return# 1)
      (if (and (= Var2$ "") (= Var3$ "") (= Var4$ "") (= Var5$ "")(= Var6$ ""))
        (progn
          (alert "Enter information for Script Commands!")
          (setq Loop t)
        );progn
        (setq Loop nil)
      );if
    );if
    (setq *Script@ (change_nth 0 Var1$ *Script@))
    (setq *Script@ (change_nth (+ Index# 1) Var2$ *Script@))
    (setq *Script@ (change_nth (+ Index# 2) Var3$ *Script@))
    (setq *Script@ (change_nth (+ Index# 3) Var4$ *Script@))
    (setq *Script@ (change_nth (+ Index# 4) Var5$ *Script@))
    (setq *Script@ (change_nth (+ Index# 5) Var6$ *Script@))
    (if (and Loop (= Return# 2));Back
      (setq Index# (- Index# 5))
    );if
    (if (and Loop (= Return# 3));Next
      (setq Index# (+ Index# 5))
    );if
  );while
  (if (not (findfile "C:\\Temp\\Temp.scr"))
    (progn (vl-load-com)(vl-mkdir "C:\\Temp"))
  );if
  (if (or (= Var1$ "2")(= Var1$ "3"))
    (progn
      (if (>= (atoi (getvar "ACADVER")) 15)
        (if (/= (getvar "CTAB") "Model")
          (command "PSPACE")
        );if
      );if
      (if (not *Pathname$)
        (setq *Pathname$ (getvar "DWGPREFIX"))
      );if
      (if (= (getvar "DWGTITLED") 0)
        (progn
          (setq DwgName$ "C:\\Temp\\Temp.dwg");Optional name
          (if (findfile DwgName$)
            (command ".SAVEAS" "" DwgName$ "Y")
            (command ".SAVEAS" "" DwgName$)
          );if
        );progn
        (if (/= (getvar "DBMOD") 0)
          (command ".QSAVE")
        );if
      );if
    );progn
  );if
  (setq First t)
  (if (= Var1$ "1"); This Drawing only
    (progn
      (setq FileName% (open "C:\\Temp\\Temp.scr" "w"))
      (foreach Item *Script@
        (if First
          (setq First nil)
          (if (/= Item "")
            (write-line Item FileName%)
          );if
        );if
      );foreach
    );progn
  );if
  (if (= Var1$ "2"); Drawings in Folder
    (if (setq PathFilename$ (getfiled " Select a drawing in a folder to run Script" *Pathname$ "dwg" 2))
      (progn
        (setq *Pathname$ (getpath PathFilename$))
        (setq FolderDwgs@ (vl-directory-files *Pathname$ "*.dwg" 1))
        (setq FileName% (open "C:\\Temp\\Temp.scr" "w"))
        (foreach DwgName$ FolderDwgs@
          (write-line "FileOpen" FileName%)
          (write-line (strcat "\"" *Pathname$ DwgName$ "\"") FileName%)
          (setq First t)
          (foreach Item *Script@
            (if First
              (setq First nil)
              (if (/= Item "")
                (write-line Item FileName%)
              );if
            );if
          );foreach
          (write-line "(if(/=(getvar\"DBMOD\")0)(command\"QSAVE\"))" FileName%)
        );foreach
        (if (findfile (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")))
          (progn
            (write-line "FileOpen" FileName%)
            (write-line (strcat "\"" (getvar "DWGPREFIX") (getvar "DWGNAME") "\"") FileName%)
          );progn
        );if
      );progn
      (exit)
    );if
  );if
  (if (= Var1$ "3"); DXF files in Folder
    (if (setq PathFilename$ (getfiled " Select a DXF file in a folder to run Script" *Pathname$ "dxf" 2))
      (progn
        (setq *Pathname$ (getpath PathFilename$))
        (setq FolderDxfs@ (vl-directory-files *Pathname$ "*.dxf" 1))
        (setq FileName% (open "C:\\Temp\\Temp.scr" "w"))
        (foreach DxfName$ FolderDxfs@
          (write-line "FileOpen" FileName%)
          (write-line (strcat "\"" *Pathname$ DxfName$ "\"") FileName%)
          (setq First t)
          (foreach Item *Script@
            (if First
              (setq First nil)
              (if (/= Item "")
                (write-line Item FileName%)
              );if
            );if
          );foreach
          (write-line "SaveAs dxf 16" FileName%)
          (write-line (strcat "\"" *Pathname$ DxfName$ "\"") FileName%)
          (write-line "Y" FileName%)
        );foreach
        (if (findfile (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")))
          (progn
            (write-line "FileOpen" FileName%)
            (write-line (strcat "\"" (getvar "DWGPREFIX") (getvar "DWGNAME") "\"") FileName%)
          );progn
        );if
      );progn
      (exit)
    );if
  );if
  (write-line "(princ \"\\n \\n \")(princ)" FileName%)
  (close FileName%)
  (setvar "OSMODE" 0)
  (command "SCRIPT" "C:\\Temp\\Temp.scr")
  (princ)
);defun c:Scrs
;-------------------------------------------------------------------------------
; Start of Scrs Support Utility Functions
;-------------------------------------------------------------------------------
; Change_nth - Changes the nth item in a list with a new item value.
; Arguments: 3
;   Num# = Nth number in list to change
;   Value = New item value to change to
;   OldList@ = List to change item value
; Returns: A list with the nth item value changed.
;-------------------------------------------------------------------------------
(defun Change_nth (Num# Value OldList@)
  (if (<= 0 Num# (1- (length OldList@)))
    (if (> Num# 0)
      (cons (car OldList@) (Change_nth (1- Num#) Value (cdr OldList@)))
      (cons Value (cdr OldList@))
    );if
    OldList@
  );if
);defun Change_nth
;-------------------------------------------------------------------------------
; GetDwgsList - Returns a list of open drawings
; Use (length (GetDwgsList)) for the number of open drawings.
;-------------------------------------------------------------------------------
(defun GetDwgsList (/ AcadObj DocsObj DwgsList@)
  (if (>= (atoi (getvar "ACADVER")) 15)
    (progn
      (setq AcadObj (vlax-get-acad-object)
            DocsObj (vlax-get-property AcadObj "Documents")
      );setq
      (vlax-for ForItem DocsObj
        (setq DwgsList@ (cons (strcat (vlax-get-property ForItem "Path") "\\"
        (vlax-get-property ForItem "Name")) DwgsList@))
      );vlax-for
      (setq DwgsList@ (reverse DwgsList@))
    );progn
    (setq DwgsList@ (list (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))))
  );if
  DwgsList@
);defun GetDwgsList
;-------------------------------------------------------------------------------
; GetPath - Used to get the path from the path and filename.
; Arguments: 1
;   PathFilename$ = Path and filename string
; Returns: Pathname string.
;-------------------------------------------------------------------------------
(defun GetPath (PathFilename$)
  (strcat (vl-filename-directory PathFilename$) "\\")
);defun GetPath
;-------------------------------------------------------------------------------
; GetLayoutList - Returns a list of layouts in the drawing in tab order
;-------------------------------------------------------------------------------
(defun GetLayoutList (/ Layouts@)
  (vlax-map-collection (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
    '(lambda (x) (setq Layouts@ (cons x Layouts@)))
  );vlax-map-collection
  (setq Layouts@ (vl-sort Layouts@ '(lambda (x y) (< (vla-get-taborder x) (vla-get-taborder y)))))
  (vl-remove "Model" (mapcar '(lambda (x) (vla-get-name x)) Layouts@))
);defun GetLayoutList
;-------------------------------------------------------------------------------
; c:ZoomE - Zoom extents in all layouts
;-------------------------------------------------------------------------------
(defun c:ZoomE (/ Layout$)
  (command "LAYOUT" "S" "Model")
  (command "ZOOM" "E")
  (foreach Layout$ (GetLayoutList)
    (command "PSPACE")
    (command "ZOOM" "E")
  );foreach
  (command "LAYOUT" "S" (nth 0 (GetLayoutList)))
  (princ)
);defun c:ZoomE
;-------------------------------------------------------------------------------
; c:Purged - Purges All including null strings
;-------------------------------------------------------------------------------
(defun c:Purged (/ SS&)
  (command ".LAYER" "T" "0" "U" "0" "ON" "0" "S" "0" "")
  (setq SS& (ssget "X" '(
        (-4 . "<OR")
           ;(0 . "POINT");Optional
            (-4 . "<AND")
                (0 . "TEXT")
                (-4 . "<OR")
                  (1 . "")
                  (1 . " ")
                (-4 . "OR>")
            (-4 . "AND>")
            (-4 . "<AND")
                (0 . "MTEXT")
                (-4 . "<OR")
                  (1 . "")
                  (1 . " ")
                  (1 . "  ")
                  (1 . "\\A1;")
                  (1 . "\\A1; ")
                  (1 . "\\A1;  ")
                (-4 . "OR>")
            (-4 . "AND>")
        (-4 . "OR>")
      )
    );ssget
  );setq
  (if SS& (command "ERASE" SS& ""))
  (repeat 4 (command "PURGE" "A" "*" "N"))
  (princ "\n \n \n \n \n \n \nPurged including null strings")
  (princ)
);defun c:Purged
;-------------------------------------------------------------------------------
(princ);End of Scrs.lsp