Jump to content

search file with windows explorer from lisp....


Recommended Posts

Posted

The following occurs to me and I don't know if it exists.

I usually look for files in a directory

I would like to run windows explorer with the default path of the place where the files are

and search there, but all from autocad.

  example:

 

1.- call routine "findx" (example name)

2.- write part of file... example 301528

 

and run Windows Explorer with the previously selected path searching for the file.

 

there is something similar?

 

thanks for your comments

 

 

 

 

Posted

I found this from the Master Lee MAc  ,but I still don't know how it works

;; Findfile  -  Lee Mac
;; Searches the supplied directory and all subdirectories of the supplied directory for the specified file.
;; fnm - [str] File to search, e.g. "MyFile.txt"
;; dir - [str] Root directory
;; Returns: [str] Full filename of file if found, else nil.

(defun LM:findfile ( fnm dir )
    (setq dir (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)))
    (cond
        (   (findfile (strcat dir "\\" fnm)))
        (   (vl-some '(lambda ( x ) (LM:findfile fnm (strcat dir "\\" x)))
                (vl-remove "." (vl-remove ".." (vl-directory-files dir nil -1)))
            )
        )
    )
)

 

Example Function Call

_$ (LM:findfile "MyFile.txt" "C:\\MyFolder") "C:\\MyFolder\\SubFolder\\MyFile.txt"

 

I think it's what I need but I don't know how to execute it

 

 

Posted (edited)

once made (and posted) this one for fun. Use function (c:t2) : select folder , app searches *.* and displays them in listbox. With out clicking on anything start typing letters and numbers that should be part of filename. The more you type , the smaller the list becomes. When list is small enough press ok and all files in listbox will be openend. So make sure your list box doesn't still contain 100 drawings because it will try to open every single one of them and app is very hard to kill (use ctr-alt-del)

;;; DIP - Dynamic Input , Rlx Sep'23
;;; sort of (grread) for dcl with exception for space, tab & enter which are reserved by dcl
;;; haven't (yet) found a way to catch character for space.
;;; So gonna use ' (quote) for space, not ideal but it is what it is

(vl-load-com)

(defun dip ( %lst  / dip-list dip-width key-lst imb-str capslock bksp bksl qmrk
                     eb-txt f p d r ib dialog-list drv lb-sel return-list)
  (setq dip-list %lst)
  ;;; make sure all elements are strings
  (setq dip-list (mapcar 'vl-princ-to-string dip-list))
  ;;; find length of longest member
  (setq dip-width (car (vl-sort (mapcar 'strlen dip-list) '>)))
  ;;; create key codes
  (setq key-lst
    (vl-remove-if '(lambda (x)(member x '(34 92))) (append (gnum 33 95) (gnum 123 125))))
  (setq imb-str
    ":image_button {color=dialog_background;width=0.1;height=0.1;fixed_height=true;key=\"ib_")
  ;;; see if acet-sys-keystate function is available
  (setq capslock (member 'acet-sys-keystate (atoms-family 0)) eb-txt ""
        bksp (strcat ":image_button {color=dialog_background;width=0.1;height=0.1;"
                     "fixed_height=true;key=\"ib_bksp\";label=\"&\010\";}")
        bksl (strcat ":image_button {mnemonic=\"\\\\\";color=dialog_background;width=0.1;"
                     "height=0.1;fixed_height=true;key=\"ib_bksl\";label=\"&\\\\\";}")
        qmrk (strcat ":image_button {mnemonic=\"\\\"\";color=dialog_background;width=0.1;"
                     "height=0.1;fixed_height=true;key=\"ib_qmrk\";label=\"&\\\"\";}")
  )
  
  (and
    (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
    
    (mapcar '(lambda (x) (write-line x p))
      (append
        (list "dip:dialog {label=\"DIP - Dynamic Input (Rlx Sep'23)\";:row {alignment=centered;")
        (crim) (list bksp bksl qmrk "}")
        (list ":image_button {color=141;height=1;fixed_height=true;key=\"ib_ib\";}"
              ":text_part {key=\"tp\";height=1;width=40;}" )
        (list (strcat ":list_box {height=25;width=" (itoa (fix (* dip-width 0.9)))
                      ";key=\"lb\";multiple_select=true;}") "ok_cancel;" "}") ) )
    
    (not (setq p (close p))) (< 0 (setq d (load_dialog f))) (new_dialog "dip" d)
    (progn
      (upd_lbox)
      (action_tile "ib_bksp" "(upd_txtp $key)") (action_tile "ib_bksl" "(upd_txtp $key)")
      (action_tile "ib_qmrk" "(upd_txtp $key)") (stim) (action_tile "lb" "(setq lb-sel $value)")
      (action_tile "accept"  "(done_dialog 1)") (action_tile "cancel"  "(done_dialog 0)")
      (setq drv (start_dialog)) (unload_dialog d) (vl-file-delete f)
    )
  )
  (cond
    ((= drv 0))
    ((= drv 1)
     (cond
       ((and (boundp lb-sel) (vl-consp dialog-list))
        (setq return-list (mapcar '(lambda (x)(nth (atoi x) dialog-list)) (SplitStr lb-sel ""))))
       ((vl-consp dialog-list) (setq return-list dialog-list)) (t (setq return-list nil)) ) )
    (t (setq return-list nil))
  )
  return-list
)


;;; create image_buttons : (setq lst (gimb)) 
(defun crim  ()
  (mapcar '(lambda (x)(strcat imb-str (chr x) "\";label=\"&" (chr x) "\";}")) key-lst))
;;; start image_buttons
(defun stim ()
  (foreach x key-lst (action_tile (strcat "ib_" (chr x)) "(upd_txtp $key)")))

;;; update edit_box , k = key (ib_$)
(defun upd_txtp ( k / s l)
  (cond
    ;;; backspace
    ((and (eq k "ib_bksp") (> (setq l (strlen eb-txt)) 1))
     (setq eb-txt (substr eb-txt 1 (1- l))))
    ;;; backslash
    ((eq k "ib_bksl") (setq eb-txt (strcat eb-txt "\\")))
    ;;; quotation mark
    ((eq k "ib_qmrk") (setq eb-txt (strcat eb-txt "\"")))
    ;;; use ' for space
    ((eq k "ib_'") (setq eb-txt (strcat eb-txt " ")))
    (t (setq eb-txt (strcat eb-txt (case (substr k 4)))))
  )
  (if (wcmatch (strcase eb-txt t) "*bksp")(setq eb-txt ""))
  (start_image "ib_ib")
    (fill_image 0 0 (dimx_tile "ib_ib") (dimy_tile "ib_ib") 141)
  (end_image)
  (set_tile "ib_ib" eb-txt)
  (mode_tile k 2)
  (upd_lbox)
)

(defun upd_lbox ( / filter)
  (if (not (vl-consp dip-list)) (setq dip-list '("void")))
  (cond
    ((= eb-txt "") (setq dialog-list dip-list))
    (t
     (setq filter (strcat "*" eb-txt "*"))
     (setq dialog-list
       (vl-remove-if-not '(lambda (x)(wcmatch (strcase x) (strcase filter))) dip-list))
    )
  )
  (start_list "lb") (mapcar 'add_list dialog-list) (end_list)
  (set_tile "tp" (strcat " selected " (itoa (length dialog-list)) " of " (itoa (length dip-list))))
)

;;; helper functions

;;; determine status caps lock for when typing filter (even though filter uses strcase)
(defun case (s) (cond ((null s) "") ((not (eq (type s) 'STR)) "")
  ((null capslock) s) (t (if (= (acet-sys-keystate 20) 0) (strcase s t) (strcase s)))))

;;; generate number (gnum 1 5) -> '(1 2 3 4 5)
(defun gnum (s e / i l)
  (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l))

; (SplitStr "a,b" ",") -> ("a" "b")
(defun SplitStr (s d / p)
  (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s)))

;;; d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil)
(defun alf (d e f) (setq d (vl-string-right-trim "/" (vl-string-translate "\\" "/" d)))
  (if f (apply 'append (cons (if (vl-directory-files d e)(mapcar '(lambda (x) (strcat d "/" x)) (vl-directory-files d e)))
    (mapcar '(lambda (x) (alf (strcat d "/" x) e f))(vl-remove ".." (vl-remove "." (vl-directory-files d nil -1))))))
      (mapcar '(lambda (x) (strcat d "/" x))(vl-directory-files d e 1))))

; generic getfolder routine with possibility to create a new subfolder (GetShellFolder "select path")
(defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application"))
  (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path))
     (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s))
  (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\")))

; returns T if no errors occurred during program execution
(defun ShellOpen ( $f / it sh )
  (if (and (not (void $f)) (setq $f (findfile $f)) (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")))
    (progn (setq it (vl-catch-all-apply 'vlax-invoke (list sh 'open $f)))(vlax-release-object sh)(not (vl-catch-all-error-p it)))
      (progn (prompt "\nShell application was unable to open file")(setq it nil))))
      
(defun void (x) (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x)))))

;;; test function
(defun c:t1 ()
  (setq lst (dip (alf (car (fnsplitl (findfile "acad.exe"))) "*.dwg" t)))
  (alert (apply 'strcat (mapcar '(lambda (x)(strcat x "\n")) lst)))
)

;;; select a folder , app finds all files , don't click anything but just start typing and list will be updated with filter you typed
;;; after that all files left will be opened so don't try to open 100 autocad drawings at once...
(defun c:t2 ( / fol lst dip-list) (if (and (setq fol (GetShellFolder "Select folder to search"))
  (vl-consp (setq lst (alf fol "*.*" t))) (vl-consp (setq dip-list (dip lst)))) (foreach f dip-list (ShellOpen f))))

 

Edited by rlx
  • Like 2
  • Thanks 1
Posted

I like it , rlx 

but the routine only searches in "C", where can you change the search path?

Posted

I think you're talking about test function c:t1 , as stated in my post above use c:t2

 

well, I'm off, wedding anniversary ... already donated one of my ribs to buy roses for the wife , now I have to feed her too... there goes another of my ribs , probably two

 

🐉

  • Funny 1
  • Thanks 1
Posted
58 minutes ago, rlx said:

once made (and posted) this one for fun. Use function (c:t2) : select folder , app searches *.* and displays them in listbox. With out clicking on anything start typing letters and numbers that should be part of filename. The more you type , the smaller the list becomes. When list is small enough press ok and all files in listbox will be openend. So make sure your list box doesn't still contain 100 drawings because it will try to open every single one of them and app is very hard to kill (use ctr-alt-del)

Pretty cool @rlx. NOTE - you are missing the function VOID in the shellopen function.

Posted

oh darn , I allways forget that one... post above updated...

 

(defun void (x) (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x)))))

  • Like 1
  • Thanks 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...