Hello,
So is got this script from Mac Lee.
When i use the button 'Directory' to browse for the drowings i get an annoying dialog box:
So, how can i get a dialog box like this:
Ive tried alot but i cant figure it out....
Gr, David
;;---------------------------=={ Script Writer }==-----------------------------;;
;; ;;
;; The program will allow the user to enter a line of script operations to be ;;
;; performed on a directory (and subdirectories) of drawings. ;;
;; ;;
;; When entering the script operations, the filename of the drawing is ;;
;; represented by the *file* token. ;;
;; ;;
;;-------------------------------------------------------------------------------;;
;; ;;
;; FUNCTION SYNTAX: WScript ;;
;; ;;
;;-------------------------------------------------------------------------------;;
;; ;;
;; Author: Lee Mac, Copyright © May 2010 - www.lee-mac.com ;;
;; ;;
;;-------------------------------------------------------------------------------;;
;; ;;
;; Version: ;;
;; ;;
;; 1.0: 31/05/2010 - First Release ;;
;;-------------------------------------------------------------------------------;;
;; 1.1: 01/06/2010 - Added Filename / Load / Save / Clear buttons. ;;
;;-------------------------------------------------------------------------------;;
;; 1.2: 02/06/2010 - Added ability to import/export .scr files. ;;
;;-------------------------------------------------------------------------------;;
(defun c:wScript
( /
;; --=={ Local Functions }==-- ;
*error*
DIR_TEXT DIRDIALOG
POPUP
READ_CONFIG REMOVENTH
WRITE_CONFIG
;; --=={ Local Variables }==-- ;
AC
CFGFNAME
DC DCFLAG DCFNAME DCTITLE DIR DOC
LST
OFILE
PTR
SAVEPATH SCRFNAME SCRLINE SCRLST SUB
TMP
UNDO
VERSIONNUMBER
;; --=={ Global Variables }==-- ;
; *SaveLst
)
;;-------------------------------------------------------------------------------;;
;; --=={ Preliminaries }==-- ;;
;;-------------------------------------------------------------------------------;;
(setq VersionNumber "2.1.1")
;;-------------------------------------------------------------------------------;;
(setq SavePath
(cond
( (setq tmp (getvar 'ROAMABLEROOTPREFIX))
(or (eq "\\" (substr tmp (strlen tmp)))
(setq tmp (strcat tmp "\\")))
(strcat tmp "Support\\")
)
( (setq tmp (findfile "ACAD.pat"))
(setq tmp (vl-filename-directory tmp))
(or (eq "\\" (substr tmp (strlen tmp)))
(setq tmp (strcat tmp "\\")))
tmp
)
(t
(popup "Warning" 16 "DCL Save Path not Valid")
(exit)
)
)
)
;;-------------------------------------------------------------------------------;;
(setq dcfname (strcat SavePath "LMAC_WScript_V" VersionNumber ".dcl")
cfgfname (strcat SavePath "LMAC_WScript_V" VersionNumber ".cfg")
scrfname (strcat SavePath "LMAC_WScript_V" VersionNumber ".scr")
dctitle (strcat "Script lader VDE V" VersionNumber))
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
;;-------------------------------------------------------------------------------;;
;; --=={ Local Functions }==-- ;;
;;-------------------------------------------------------------------------------;;
(defun *error* ( msg )
(and Undo (vla-EndUndoMark doc))
(and dc (unload_dialog dc))
(and ofile (close ofile))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
;;-------------------------------------------------------------------------------;;
(defun Popup (title flags msg / WSHShell result)
(setq WSHShell (vlax-create-object "WScript.Shell"))
(setq result (vlax-invoke WSHShell 'Popup msg 0 title flags))
(vlax-release-object WSHShell)
result
)
;;-------------------------------------------------------------------------------;;
(defun write_config ( fname lst / ofile )
(if (setq ofile (open fname "w"))
(progn
(foreach x lst
(write-line (vl-prin1-to-string x) ofile))
(setq ofile (close ofile))
t
)
)
)
;-------------------------------------------------------------------------------;
(defun read_config ( fname lst / ofile )
(if (and (setq fname (findfile fname))
(setq ofile (open fname "r")))
(progn
(foreach x lst
(set x
(read
(read-line ofile)
)
)
)
(setq ofile (close ofile))
lst
)
)
)
;-------------------------------------------------------------------------------;
(defun Dir_Text ( key str )
(set_tile key
(if str
(if (< 50 (strlen str))
(strcat (substr str 1 47) "...") str
)
""
)
)
)
;-------------------------------------------------------------------------------;
(defun DirDialog ( msg dir flag / Shell Fold Path )
(setq Shell (vla-getInterfaceObject
(setq ac (vlax-get-acad-object)) "Shell.Application")
Fold (vlax-invoke-method Shell 'BrowseForFolder
(vla-get-HWND ac) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Path (vlax-get-property
(vlax-get-property Fold 'Self) 'Path))
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)
;-------------------------------------------------------------------------------;
(defun dcl_write ( fname / ofile )
(if (not (findfile fname))
(if (setq ofile (open fname "w"))
(progn
(foreach str
'(
"//-----------------------=={ WScript Dialog Definition }==---------------------//"
"// //"
"// WScript.dcl to be used in conjunction with WScript.lsp. //"
"//-------------------------------------------------------------------------------//"
"// Author: Lee Mac, Copyright © May 2010 - www.lee-mac.com //"
"//-------------------------------------------------------------------------------//"
""
"// --=={ Sub-Assembly Definitions }==--"
""
"butt12 : button { width = 12; fixed_width = true; alignment = centered; }"
"butt15 : button { width = 15; fixed_width = true; alignment = centered; }"
"butt15t : button { width = 15; fixed_width = true; alignment = centered; height = 2.5; fixed_height = true; }"
""
"//-------------------------------------------------------------------------------//"
"// Main Dialog Definition //"
"//-------------------------------------------------------------------------------//"
""
"wscript : dialog { key = \"dctitle\";"
" spacer;"
""
" : text { alignment = right; label = \"Copyright (c) 2015 Van Doren Engineers\"; }"
" : boxed_column { label = \"Lees dit eerst goed\";"
""
" : text { label = \"- Zorg dat de tekening die je open hebt staan GEEN tekening is die\";"
" alignment = left; }"
" : text { label = \" gewijzigd moet worden.\";"
" alignment = left; }"
" : text { label = \"- Om te beginnen druk op 'Load Script'. Hier staat een lijst met script's\";"
" alignment = left; }"
" : text { label = \" die eerder door jou zijn gebruikt.\";"
" alignment = left; }"
" : text { label = \"- Om een nieuwe script toe te voegen druk op 'Browse...'\";"
" alignment = left; }"
" : text { label = \" De locatie van de VDE script's wordt direct weergegeven.\";"
" alignment = left; }"
" : text { label = \"- Selecteer hier een script die je wil gebruiken. Druk op 'Openen'.\";"
" alignment = left; }"
" : text { label = \"- Controleer of de commando's kloppen. Alles wat tussen <haakjes> staat\";"
" alignment = left; }"
" : text { label = \" dient (inclusie de '< >') vervangen te worden door wat er gevraagd wordt.\";"
" alignment = left; }"
" : text { label = \"- Selecteer de map waar de tekeningen in staan door te drukken op 'Directory'.\";"
" alignment = left; }"
" : text { label = \"\";"
" alignment = left; }"
" : text { label = \"-- LET OP! ALLE tekeningen in de geselecteerde map worden aangepast. --\";"
" alignment = centered; }"
" : text { label = \"\";"
" alignment = left; }"
" : text { label = \"- Selecteer de gewenste map en druk vervolgens op OK.\";"
" alignment = left; }"
" : text { label = \"- Druk op 'Run Script!' en het programma wordt uitgevoerd.\";"
" alignment = left; }"
""
" }"
""
" spacer;"
""
" : edit_box { edit_width = 50; edit_limit = 2048; fixed_width = true; label = \"Script Commando:\"; key = \"scr\"; }"
""
" spacer;"
""
" : row {"
""
" : butt15 { key = \"fn\"; label = \"&Filename\" ; mnemonic = \"F\"; }"
""
" : butt15 { key = \"ld\"; label = \"&Load Script\"; mnemonic = \"L\"; }"
""
" : butt15 { key = \"sv\"; label = \"&Save Script\"; mnemonic = \"S\"; }"
""
" : butt15 { key = \"cl\"; label = \"&Clear\" ; mnemonic = \"C\"; }"
""
" }"
""
" spacer;"
""
" : boxed_column { label = \"Locatie tekeningenpakket\";"
""
" : row {"
""
" : text { alignment = left; key = \"dir_text\"; }"
""
" : butt12 { key = \"dir\"; label = \"&Directory\"; mnemonic = \"D\"; }"
""
" }"
""
" : toggle { label = \"&Include Sub-Directories\"; key = \"sub_dir\"; mnemonic = \"I\"; }"
""
" spacer;"
""
" }"
""
" spacer;"
""
" : row {"
""
" : spacer { width = 16.06; fixed_width = true; }"
""
" : butt15t { key = \"accept\"; label = \"&Run Script!\"; is_default = true; mnemonic = \"R\"; }"
""
" : butt15t { key = \"cancel\"; label = \"C&ancel\" ; is_cancel = true; mnemonic = \"a\"; }"
""
" : column { spacer;"
""
" : image { key = \"logo\"; alignment = centered;"
" width = 16.06 ; fixed_width = true;"
" height = 2.06 ; fixed_height = true; color = -15; }"
" }"
""
" }"
""
"}"
""
"loadscript : dialog { label = \"Selecteer de te laden Script\";"
" spacer;"
""
" : list_box { key = \"scrlst\"; width = 64; fixed_width = true; alignment = centered; }"
""
" spacer;"
""
" : row {"
""
" : butt15 { key = \"accept\"; label = \"&Load\" ; is_default = true; mnemonic = \"L\"; }"
""
" : butt15 { key = \"cancel\"; label = \"&Cancel\" ; is_cancel = true; mnemonic = \"C\"; }"
""
" : butt15 { key = \"delete\"; label = \"&Delete\" ; mnemonic = \"D\"; }"
""
" : butt15 { key = \"browse\"; label = \"&Browse...\"; mnemonic = \"B\"; }"
""
" }"
""
" spacer;"
" "
"}"
""
"//-------------------------------------------------------------------------------//"
"// End of File //"
"//-------------------------------------------------------------------------------//"
)
(write-line str ofile)
)
(setq ofile (close ofile))
t) ; File written successfully
nil) ; File not Opened
t)) ; DCL file already exists
;-------------------------------------------------------------------------------;
;-------------------------------------------------------------------------------;
(defun MakeList ( key lst )
(start_list key)
(mapcar (function add_list) lst)
(end_list)
lst
)
;-------------------------------------------------------------------------------;
(defun RemoveNth ( n lst )
(
(lambda ( i )
(vl-remove-if
(function
(lambda ( x )
(= n (setq i (1+ i)))
)
)
lst
)
)
-1
)
)
;-------------------------------------------------------------------------------;
(defun LoadScript ( handle / _read GetScriptLine ptr line tmp )
(defun _read ( file / ofile nl )
(cond
( (setq ofile (open file "r"))
(while (and (setq nl (read-line ofile)) (eq "" nl)))
(setq ofile (close ofile))
)
)
nl
)
(defun GetScriptLine ( string / lst )
(if (setq lst (StringParser string "\""))
(apply (function strcat)
(mapcar
(function
(lambda ( x )
(if (or (not (eq "" (vl-filename-directory x)))
(findfile x))
"*file*"
x
)
)
)
lst
)
)
)
)
(cond
( (not (new_dialog "loadscript" handle))
(popup "Warning" 16 "Load Dialog Could not be Loaded")
(princ "\n** Load Dialog Could not be Loaded **")
)
(t
(MakeList "scrlst" *SaveLst)
(if *SaveLst (setq ptr (set_tile "scrlst" "0")))
(action_tile "scrlst" "(setq ptr $value)")
(action_tile "delete"
(vl-prin1-to-string
(quote
(progn
(if ptr
(progn
(MakeList "scrlst" (setq *SaveLst (RemoveNth (atoi ptr) *SaveLst)))
(setq ptr
(if *SaveLst
(set_tile "scrlst" "0")
)
)
)
)
)
)
)
)
(action_tile "browse"
(vl-prin1-to-string
(quote
(progn
(if (and (setq tmp (getfiled "Select Script File" "Z:\Project/Bibliotheek/TEKENKA/AUTOCAD/Autocad MSD-Menu/ScriptRunner/Scripts" "scr" 16))
(setq line (_read tmp))
(setq line (GetScriptLine line)))
(progn
(setq *SaveLst (cons (setq ptr line) *SaveLst))
(done_dialog 1)
)
)
)
)
)
)
(action_tile "accept" "(if ptr (setq ptr (nth (atoi ptr) *SaveLst))) (done_dialog 1)")
(action_tile "cancel" "(setq ptr nil) (done_dialog 0)")
(start_dialog)
)
)
ptr
)
;;-------------------------------------------------------------------------------;;
;; --=={ Main Function }==-- ;;
;;-------------------------------------------------------------------------------;;
;;----------------------------=={ Setup Defaults }==---------------------------;;
(or (findfile cfgfname)
(write_config cfgfname (list "_.open *file* _.saveas *file* _.close" (getvar 'DWGPREFIX) "0" 'nil)))
(read_config cfgfname '(ScrLine Dir Sub *SaveLst))
(or ScrLine (setq ScrLine "_.open *file* _.saveas *file* _.close"))
(or Dir (setq Dir (getvar 'DWGPREFIX)))
(or Sub (setq Sub "0"))
;;-------------------------------------------------------------------------------;;
(cond
( (not (DCL_Write dcfname))
(popup "Warning" 16 "DCL File Could not be Written")
(princ "\n** Dialog File Could not be Written")
)
( (<= (setq dc (load_dialog dcfname)) 0)
(popup "Warning" 16 "Dialog File not Found")
(princ "\n** Dialog File not Found **")
)
( (not (new_dialog "wscript" dc))
(popup "Warning" 16 "Dialog Could not be Loaded")
(princ "\n** Dialog Could not be Loaded **")
)
(t
(mapcar (function set_tile) '("dctitle" "sub_dir" "scr") (list dctitle Sub ScrLine))
(Dir_Text "dir_text"
(setq Dir
(cond
((vl-file-directory-p Dir) Dir) ((getvar 'DWGPREFIX))
)
)
)
(action_tile "dir"
(vl-prin1-to-string
(quote
(progn
(if (setq tmp (DirDialog "Select Directory of Drawings to Process..." nil 512))
(Dir_Text "dir_text" (setq Dir tmp))
)
)
)
)
)
(action_tile "fn"
(vl-prin1-to-string
(quote
(progn
(set_tile "scr" (setq ScrLine (strcat ScrLine "*file*")))
)
)
)
)
(action_tile "cl"
(vl-prin1-to-string
(quote
(progn
(set_tile "scr" (setq ScrLine ""))
(mode_tile "scr" 2)
)
)
)
)
(action_tile "ld"
(vl-prin1-to-string
(quote
(progn
(cond
( (setq tmp (LoadScript dc))
(setq ScrLine (set_tile "scr" tmp))
)
)
)
)
)
)
(action_tile "sv"
(vl-prin1-to-string
(quote
(progn
(cond
( (zerop (strlen ScrLine))
(popup "Information" 48 "No Script Operations Entered!")
)
( (< (length (setq ScrLst (StringParser ScrLine "*file*"))) 2)
(popup "Information" 64 "Delimiter *file* not found in Script String")
)
( (and (setq tmp (getfiled "Save Script As" "" "scr" 1))
(setq ofile (open tmp "w")))
(foreach filepath (GetAllFiles Dir (eq "1" Sub) "*.dwg")
(write-line (lst->str ScrLst (strcat (chr 34) filepath (chr 34))) ofile)
)
(setq ofile (close ofile))
(if (not (vl-position ScrLine *SaveLst))
(setq *SaveLst (cons ScrLine *SaveLst))
)
(popup "Information" 64 "Script Saved.")
)
)
)
)
)
)
(action_tile "sub_dir" "(setq Sub $value)")
(action_tile "scr" "(setq ScrLine $value)")
(action_tile "accept"
(vl-prin1-to-string
(quote
(progn
(cond
( (zerop (strlen ScrLine))
(popup "Information" 64 "Please Enter a Script Line")
)
( (< (length (setq ScrLst (StringParser ScrLine "*file*"))) 2)
(popup "Information" 64 "Delimiter *file* not found in Script String")
)
( (done_dialog 1) )
)
)
)
)
)
(setq dcFlag (start_dialog) dc (unload_dialog dc))
(if (and (= 1 dcFlag) (setq ofile (open scrfname "w")))
(progn
(setq Undo (not (vla-StartUndoMark doc)))
(foreach filepath (GetAllFiles Dir (eq "1" Sub) "*.dwg")
(write-line (lst->str ScrLst (strcat (chr 34) filepath (chr 34))) ofile)
)
(setq ofile (close ofile))
(write_config cfgfname (list ScrLine Dir Sub *SaveLst))
(setq Undo (vla-EndUndomark doc))
(vl-cmdf "_.script" scrfname)
)
(princ "\n*Cancel*")
)
)
)
(princ)
)
(defun StringParser ( str del / pos lst )
;; © Lee Mac
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 1 (strlen del))))
)
(reverse (cons str lst))
)
(defun lst->str ( lst del )
;; © Lee Mac
(
(lambda ( str )
(foreach x (cdr lst)
(setq str (strcat str del x))
)
str
)
(car lst)
)
)
;; Get All Files (Lee Mac)
;; Retrieves all Files in a Directory (and SubDirectories) which optional filter
;; Dir ~ [STR] (optional) Directory to Search, if nil function prompts for directory
;; subs ~ [BOOLE] if T, subdirectories are included.
;; filetype ~ [STR] (optional) Filter for Files of a specific type.
(defun GetAllFiles ( Dir Subs Filetype / GetSubFolders ac Shell Fold Dir )
(defun GetSubFolders (folder / _f)
(mapcar
(function
(lambda ( f ) (setq _f (strcat folder "\\" f))
(cons _f (apply (function append)
(GetSubFolders _f)))
)
)
(cddr (vl-directory-files folder nil -1))
)
)
(cond
( (not
(or
(and Dir (vl-file-directory-p Dir))
(progn
(setq Shell (vla-getInterfaceObject
(setq ac (vlax-get-acad-object)) "Shell.Application")
Fold (vlax-invoke-method Shell 'BrowseForFolder
(vla-get-HWND ac) "Select Directory" 512))
(vlax-release-object Shell)
(if Fold
(progn
(setq Dir (vlax-get-property
(vlax-get-property Fold 'Self) 'Path))
(vlax-release-object Fold)
(and (= "\\" (substr Dir (strlen Dir)))
(setq Dir (substr Dir 1 (1- (strlen Dir)))))
Dir
)
)
)
)
)
)
( (apply (function append)
(vl-remove (quote nil)
(mapcar
(function
(lambda ( Filepath )
(mapcar
(function
(lambda ( Filename )
(strcat Filepath "\\" Filename)
)
)
(vl-directory-files Filepath Filetype 1)
)
)
)
(append (list Dir)
(apply (function append)
(if subs (GetSubFolders Dir))
)
)
)
)
)
)
)
)
(vl-load-com)
(princ "\n:: Script Writer | Version 1.2 | © Lee Mac 2010 www.lee-mac.com ::")
(princ "\n:: Type \"WScript\" to Invoke ::")
(princ)
;;-------------------------------------------------------------------------------;;
;; End of File ;;
;;-------------------------------------------------------------------------------;;
