Directory select with only lisp

[T.Willey]

I finally got this to work (hopefully it works for other also). I am posting the code and attaching the ".dcl" file for anyone to use. The main routine is "directory-dia".
Have fun.
Tim

ps. erase the ".zip" to use the dcl file.

(defun list-drives ( / c i)
;By Tony Tanzillo

(setq i 66)
(repeat 24
(setq c (chr (setq i (1+ i))))
(if (findfile (strcat c ":\\."))
(setq rslt (cons (strcat c ":") rslt))
)
)
(setq rslt (reverse rslt))
)

;==========================================

(defun directory-dia(/ dplc dsub listvl rslt ddia1)

(setq ddia1 (load_dialog "DirSelect.dcl"))
(if (not (new_dialog "Direct" ddia1))
(exit)
);-if
(list-drives)
(mode_tile "d-save" 1)
(mode_tile "lbox1" 2)
(start_list "lbox1" 3); clear the list
(mapcar 'add_list rslt)
(end_list)
(action_tile "lbox1" "(if (= $reason 4) (UPDATE-DIA) )")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel"
"(progn
(setq dpathdir nil)
(done_dialog 1)
)"
)
(start_dialog)

)

;============================================

(defun update-dia (/ flag1)

(setq dplc (atoi $value))
(if (not dsub)
(setq listvl (strcat (nth dplc rslt) "\\"))
(setq listvl (strcat (nth dplc dsub) "\\"))
)
(if (= listvl "..\\")
(step1back)
(if dpathdir
(setq dpathdir (strcat dpathdir listvl))
(setq dpathdir listvl)
)
)
(if (/= flag1 "no")
(progn
(setq dsub (vl-directory-files dpathdir nil -1))
(if (= dsub nil)
(setq dsub (list ".."))
(if (not (member ".." dsub))
(setq dsub (reverse (append (reverse dsub) (list ".."))))
)
)
(setq dsub (vl-remove "." dsub))
(start_list "lbox1" 3)
(mapcar 'add_list dsub)
(end_list)
(set_tile "choice1" dpathdir)
)
(progn
(start_list "lbox1" 3)
(mapcar 'add_list rslt)
(end_list)
(setq dpathdir nil)
(setq dsub nil)
(set_tile "choice1" "")
)
)
)

;===============================================

(defun step1back(/ cnt1)

(setq cnt1 (strlen dpathdir))
(setq cnt1 (1- cnt1))
(while (and (/= (substr dpathdir cnt1 1) "\\") (> cnt1 1))
(setq dpathdir (substr dpathdir 1 (1- cnt1)))
(setq cnt1 (1- cnt1))
)
(if (<= cnt1 1)
(setq flag1 "no")
)

)

[GaryDF]

Added this to dcl file for bold text in the list box
fixed_width_font=true;

Gary

Direct:dialog {label="Select Directory";
:row {
:list_box {key="lbox1"; width=60; height=15; multiple_select=true;
fixed_width_font=true;}
}
:text {key="choice1";}
:row {
:spacer {}
:button {label="OK"; is_default=true; allow_accept=true; key="accept";
width=8; fixed_width=true;}
:button {label="Cancel"; is_cancel=true; key="cancel"; width=8;
fixed_width=true;}
:spacer {}
}
}

"GaryDF" <fow...@architettura-inc.com> wrote in message
news:410fde1a$1_2@newsprd01...
> Nice...........
>
> Gary
>
>
>
>
> "T.Willey" <nos...@address.withheld> wrote in message
> news:738912.1091555492...@jiveforum1.autodesk.com...

[T.Willey]

Gary,

Nice idea (I added it now also). Still learning dcl, so thanks for the tip.

Tim

[GaryDF]

And added it here
:text {key="choice1"; fixed_width_font=true;}

Gary

"T.Willey" <nos...@address.withheld> wrote in message

news:14208668.109156164...@jiveforum1.autodesk.com...

[T.Willey]

Should take out this I guess:
multiple_select=true;
from the list box. It doesn't really matter because I don't use the variable used from it, but just in case.

Tim

[GaryDF]

That's right, or use
multiple_select=false;

Question: how do you use this routine and the global varable dpathdir?

Gary

"T.Willey" <nos...@address.withheld> wrote in message

news:29448265.109156365...@jiveforum1.autodesk.com...

[T.Willey]

Here is snip of one of my codes. I use this one to update revision levels on our title blocks.

(defun REV-OPEN()

(DIRECTORY-DIA) <-- here is the routine
(setq dl2 dpathdir) <-- here is where i use the path (i set it to something else just so i didn't have to rewrite a lot of routines.)
(setq dl3 (vl-directory-files dl2 "*.dwg")) <-- here is where i get all drawings in the directory returned by "dpathdir" (since dl2 = dpathdir)

<snip>

This is just one sub routine. This part opens drawings that I put in the list then runs one of the other subroutines. Here is where I localize it within this routine:

(defun c:3RV (/ op1 opnum ck1 ck2 sv1 bset1 bnm1 bent1 ip isp cnt1 rmu rmblk cnt1 rdia rdia1 rdia2
att1 att2 att3 att4 att5 att6 att7 att8 att9 av1 av2 av3 av4 av5 av6 av7 av8 av9 os1 bset1 blk1
dl1 sl2 sl3 sl4 sl5 dlng1 dlng2 rlist cdat rev-dat revlist dname1 dpathdir) <-- the last one

It seems to work for me. Hope that is clear enough.

Tim

ps. I also put this into my ".mnl" file so that it is there all the time, I just have to call it with one of my other routines.

[T.Willey]

Here is a revised one. I added a (vl-propagate... so that it will start again in the last directory it found, in any drawing it is used in in the current acad session. I like the way it works better now.

Tim

(defun list-drives ( / c i)
;By Tony Tanzillo

;Revised by Tim Willey

(if dpathdir
(progn
(setq rslt (vl-directory-files dpathdir nil -1))
(if (= rslt nil)
(setq rslt (list ".."))
(if (not (member ".." rslt))
(setq rslt (reverse (append (reverse rslt) (list ".."))))
)
)
(setq rslt (vl-remove "." rslt))

(start_list "lbox1" 3)
(mapcar 'add_list rslt)
(end_list)
(set_tile "choice1" dpathdir)
)
(progn

;==========================================

(vl-propagate 'dpathdir)

[Tony Tanzillo]

Ditch the DCL.

Try this:

(defun BrowseForFolder ( / sh folder parentfolder folderobject result)
(vl-load-com)
(setq sh
(vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application"
)
)

(setq folder
(vlax-invoke-method
sh
'BrowseForFolder
0
""
0
)
)
(vlax-release-object sh)

(if folder
(progn
(setq parentfolder
(vlax-get-property folder 'ParentFolder)
)
(setq FolderObject
(vlax-invoke-method
ParentFolder
'ParseName
(vlax-get-property Folder 'Title)
)
)
(setq result
(vlax-get-property FolderObject 'Path)
)
(mapcar 'vlax-release-object
(list folder parentfolder folderobject)
)
result
)
)
)

--
http://www.caddzone.com

AcadXTabs: MDI Document Tabs for AutoCAD 2004/2005
http://www.acadxtabs.com

"T.Willey" <nos...@address.withheld> wrote in message

news:738912.1091555492...@jiveforum1.autodesk.com...

[T.Willey]

Tony,

Thanks. That is exactly what I wanted but I didn't know how to get there. I will have to study your code to understand it.

Tim

[j.buzbee]

Ok Tony, I give up . . . where do you find the methods associated with an
IShellDispatch2 object?

jb

"Tony Tanzillo" <tony.tanzillo/caddzone> wrote in message
news:4113edd2_1@newsprd01...

[Tony Tanzillo]

If you're using (vlax-dump-object) you won't see them.

You have to look in MSDN to find out what methods/properties are supported.

--
http://www.caddzone.com

AcadXTabs: MDI Document Tabs for AutoCAD 2004/2005
http://www.acadxtabs.com

"j.buzbee" <j...@alfonsoarchitects.com> wrote in message
news:4117e579$1_1@newsprd01...

[j.buzbee]

Yep - got it! Was hoping for a FileNav dialog . . .

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/shell/browseforfolder.asp

"Tony Tanzillo" <tony.tanzillo@U_KNOW_WHERE.com> wrote in message
news:4117e865$1_1@newsprd01...

[Tony Tanzillo]

Hmmmm... I didn't notice the 'Self' property before, which
makes it a bit simpler:

(defun BrowseForFolder ( / sh folder folderobject result)

(vl-load-com)
(setq sh
(vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application"
)
)

(setq folder
(vlax-invoke-method
sh
'BrowseForFolder
0
""
0
)
)
(vlax-release-object sh)

(if folder
(progn
(setq folderobject
(vlax-get-property folder 'Self)

)
(setq result
(vlax-get-property FolderObject 'Path)
)

(vlax-release-object folder)
(vlax-release-object FolderObject)
result
)
)
)

--
http://www.caddzone.com

AcadXTabs: MDI Document Tabs for AutoCAD 2004/2005
http://www.acadxtabs.com

"j.buzbee" <j...@alfonsoarchitects.com> wrote in message
news:4117e99a_3@newsprd01...

[Marc'Antonio Alessi]

Thanks for this,

I have found that I can can have a string prompt (see below),
is it possible to have a starting path also (like DOS_Getdir)?

; Example: (ALE_BrowseForFolder "Select drawings folder")
;
; Original BrowseForFolder by Tony Tanzillo
;
(defun ALE_BrowseForFolder (PrmStr / ShlObj Folder FldObj OutVal)
(vl-load-com)
(setq
ShlObj (vla-getInterfaceObject (vlax-get-acad-object)
"Shell.Application")
Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 PrmStr 0)
)
(vlax-release-object ShlObj)
(if Folder
(progn
(setq
FldObj (vlax-get-property Folder 'Self)
OutVal (vlax-get-property FldObj 'Path)
)
(vlax-release-object Folder)
(vlax-release-object FldObj)
OutVal
)
)
)

--

Marc'Antonio Alessi
http://xoomer.virgilio.it/alessi
(strcat "NOT a " (substr (ver) 8 4) " guru.")

[Don Butler]

This is interesting too...

(defun c:prac2 (/ shlobj)

(vl-load-com)
(setq
ShlObj (vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application"
)

)
(vlax-invoke-method ShlObj 'Explore (getvar "dwgprefix"))
(vlax-release-object ShlObj)
)

[Don Butler]

Don Butler wrote:

I'd also like to know if there is a way to default to a thumbnail view.

Don