Topic: Get Directory?

[SPDCad]

Is there a VL command for getting the directory. Something like ‘getfiled’, but for a directory not a file?
I know there is a command available if I install the 'Doslib' (Robert McNeel & Associates), but I prefer to keep the add-ons out of this lisp?

If anyone has a alternative way of allowing a user to browse for the directory name and not a file, I am all ears.
Thanks in advance.

[MP]

The FileSystemObject is one way. Is that enough info or do you want the fun of rolling your own wrapper done for you?

[Kerry]

If you dont want the fun Michael mentions ..

Code: [Select]

;|

From: Tony Tanzillo
Newsgroups: autodesk.autocad.customization

(setq folder (BrowseForFolder))


|;

(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
      )
   )
)

[whdjr]

Code: [Select]

;;;Usage: (get_folder_obj "Pick Directory ")
(defun get_folder_obj (msg)
  (vlax-invoke
    (vlax-get-or-create-object "Shell.Application")
    'browseforfolder
    0
    msg
    1
    ""
  )
)

[MP]

I like the brevity but (1) you're letting the caller worry about translating an activex object that's not native to AutoCAD (when they're probably just expecting a string), worse (2) you're not cleaning up after yourself by invoking vlax-release-object (aka memory leak).

 

[whdjr]

 

It was only a snippet from another proggy.  Sorry for ruffling your feathers. :realmad:


 :pissed:






 
No really just having fun.

Code: [Select]

;;;  del_dups.lsp by Will DeLoach
;;;         Copyright 2005
;;;
;;;   Version 1.0         July 15, 2005
;;;
;;; DESCRIPTION
;;;  Compares the files in a Target folder with those in a
;;;  Source folder and deletes the matching files from the
;;;  Target folder.
;;;
;;; LIMITATIONS
;;;  Will not delete files from the Target folder if the
;;;  files are set to Read-Only Mode.
;;;
;;; Usage: (del_dups)
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;                                                                    ;
;;;  You are hereby granted permission to use, copy and modify this    ;
;;;  software without charge, provided you do so exclusively for       ;
;;;  your own use or for use by others in your organization in the     ;
;;;  performance of their normal duties, and provided further that     ;
;;;  the above copyright notice appears in all copies and both that    ;
;;;  copyright notice and the limited warranty and restricted rights   ;
;;;  notice appear in all supporting documentation.                    ;
(defun c:del_dups (/      sfolder   tfolder flist    str
   sub      fso       src_files tar_files tfolders
   sfolders  same      cnt
  )
;;;*ERROR* Handler
  (defun *error* (msg)
    (princ "\nError: ")
    (princ msg)
    (princ)
    (if fso
      (vlax-release-object fso)
    )
    (gc)
    (princ)
  )
;;;Returns the folder object.
  (defun get_folder_obj (msg)
    (vlax-invoke
      (vlax-get-or-create-object "Shell.Application")
      'browseforfolder
      0
      msg
      1
      ""
    )
  )
;;;Returns the folder path from the folder object.
  (defun get_folder_path (obj)
    (vla-get-path
      (vlax-invoke-method (vlax-invoke-method obj 'items) 'item)
    )
  )
;;;Returns the files from the supplied folder that match the supplied extension.
  (defun get_files (path ext) (vl-directory-files path ext 1))
;;;Returns the folders from the supplied folder.
  (defun get_folders (path) (cddr (vl-directory-files path nil -1)))
;;;Joins the path a folder or a filename.
  (defun str_cat (path name) (strcat path "\\" name))
;;;Returns the Julian date for the Target and Source file.
  (defun get_date (fn tpath spath)
    (mapcar '(lambda (x) (vlax-get-property x 'datelastmodified))
    (mapcar '(lambda (y) (vlax-invoke-method fso 'GetFile y))
    (mapcar 'str_cat (list tpath spath) (list fn fn))
    )
    )
  )
;;;Deletes the files that match the criteria.
  (defun delete_files (src tar tar_path src_path / lst)
    (foreach file tar
      (if (member file src)
(and (setq lst (get_date file tar_path src_path))
     (cond ((apply '= lst)
    (vl-file-delete (str_cat tar_path file))
    (setq cnt (1+ cnt))
   )
   ((< (abs (apply '- lst)) 0.5)
    (vl-file-delete (str_cat tar_path file))
    (setq cnt (1+ cnt))
   )
     )
)
      )
    )
  )
;;;Deletes the supplied folder
  (defun vl-rmdir (path fso) (vlax-invoke fso 'deletefolder path 0))
;;;Recursive function to return all directories.
  (defun get_subs (folder / f)
    (mapcar '(lambda (x)
       (setq f (str_cat folder x))
       (cons f (apply 'append (get_subs f)))
     )
    (get_folders folder)
    )
  )
;;;Function to return matching items from two lists.
  (defun Return_Same_Items (lst1 lst2)
    (vl-remove-if-not '(lambda (x) (member x lst2)) lst1)
  )
;;;Main Program
  (mapcar 'set
  '(sfolder tfolder)
  (mapcar '(lambda (x) (get_folder_path (get_folder_obj x)))
  '("Select Source Folder"
    "Select Target Folder to delete duplicate files from"
   )
  )
  )
  (setq flist (list tfolder sfolder))
  (setq cnt 0)
  (if (eq (setq
    str (getstring T
   (strcat "\nEnter search string and file type: "
   "(ie. *.dwg, *.tmp, bp*.dwg) <*.*>"
   )
)
  )
  ""
      )
    (setq str "*.*")
  )
  (initget 1 "Yes No _T nil")
  (setq sub (getkword "\nSearch in Subdirectories? (Yes or No) "))
  (setq fso (vla-getInterfaceObject
      (vlax-get-acad-object)
      "Scripting.FileSystemObject"
    )
  )
  (mapcar 'set
  '(tar_files src_files)
  (mapcar 'get_files flist (list str str))
  )
  (delete_files src_files tar_files tfolder sfolder)
  (if sub
    (progn
      (setq
same (apply 'Return_Same_Items
    (mapcar '(lambda (x y)
       (mapcar '(lambda (w) (substr w y))
       (apply 'append (get_subs x))
       )
     )
    flist
    (mapcar '1+ (mapcar 'strlen flist))
    )
     )
      )
      (mapcar
'set
'(tfolders sfolders)
(mapcar '(lambda (x) (mapcar '(lambda (y) (strcat x y)) same))
flist
)
      )
      (mapcar '(lambda (x y)
(delete_files (get_files y str) (get_files x str) x y)
       )
      tfolders
      sfolders
      )
    )
    (princ "This is incorrect.  ")
  )
  (princ (strcat "\n" (itoa cnt) " files were deleted."))
  (if fso (vlax-release-object fso))
  (princ)
)

[MP]

Sorry Will (seems I've a talent for getting the agnry icons going today) just warning of the dangers -- someone had to do it.

[Bob Wahr]

Sorry Will (seems I've a talent for getting the agnry icons going today) just warning of the dangers -- someone had to do it.

Learn how to spell!  :pissed: :pissed: :pissed:

[MP]

Learn how to spell! :pissed: :pissed: :pissed:

[Andrea]

if you need only a dialog to select a directory....


(acet-ui-pickdir "Choose your folder" "c:\\")

[hudster]

would it not be easier just to use

Code: [Select]

(setq aa (getvar "dwgprefix"))

[whdjr]

would it not be easier just to use

Code: [Select]

(setq aa (getvar "dwgprefix"))

Only if you were trying to get the current directory.

[SPDCad]

Ok, I understand where 'whdjr' and 'Kerry' got the information to do it in VL, but where is the documentation on the ’cet-ui-pickdir’ command?
Gee, I wonder if there are a whole pile more of commands, I don’t know about and could sure use to make life simpler.

Thanks, guys and gals for the help!
I appreciate it greatly. 

[whdjr]

Ok, I understand where 'whdjr' and 'Kerry' got the information to do it in VL, but where is the documentation on the ’cet-ui-pickdir’ command?
Gee, I wonder if there are a whole pile more of commands, I don’t know about and could sure use to make life simpler.

Thanks, guys and gals for the help!
I appreciate it greatly. 

Not really any documentation just have to open some of the EpressTools lisp files in the VLIDE and read those to find out what they do.

[Kerry]

... Not really any documentation ... 

I have had communications with AutoDesk on several occasions about getting documentation on some of the Library routines they use throughout their programming.

Needless to say, they had nothing interesting to say.