Topic: Suggestion for AddSupportPath

[Serge J. Gianolla]

Hi Lee,

Was wondering if you could modify AddSupportPath found on your website? I'd appreciate if the user could nominate position of added folder in the tree. Merci

 

[Lee Mac]

Certainly Serge, I'll look to put something together for you 

[Lee Mac]

Try this Serge:

Code: [Select]

[color=GREEN];;---------------=={ Add Support Paths at N }==---------------;;[/color]
[color=GREEN];;                                                            ;;[/color]
[color=GREEN];;  Adds a list of Support Paths to those listed in the       ;;[/color]
[color=GREEN];;  AutoCAD Support Path property, excluding duplicates.      ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Arguments:                                                ;;[/color]
[color=GREEN];;  lst - List of Support Paths to Add ("C:\\Folder" ... )    ;;[/color]
[color=GREEN];;  n   - [optional] zero-based position at which to add      ;;[/color]
[color=GREEN];;        new support paths, if nil, paths are added to start ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Returns:  List of added Support Paths                     ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]

([color=BLUE]defun[/color] LM:AddSupportPathsAtN ( lst n [color=BLUE]/[/color] _lst->str _str->lst _putNth PreferenceFiles SupportPaths ) ([color=BLUE]vl-load-com[/color])

  ([color=BLUE]defun[/color] _lst->str ( lst del )
    ([color=BLUE]if[/color] ([color=BLUE]cdr[/color] lst)
      ([color=BLUE]strcat[/color] ([color=BLUE]car[/color] lst) del (_lst->str ([color=BLUE]cdr[/color] lst) del))
      ([color=BLUE]car[/color] lst)
    )
  )

  ([color=BLUE]defun[/color] _str->lst ( str del [color=BLUE]/[/color] pos )
    ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pos ([color=BLUE]vl-string-search[/color] del str))
      ([color=BLUE]vl-remove[/color] [color=MAROON]""[/color] ([color=BLUE]cons[/color] ([color=BLUE]substr[/color] str 1 pos) (_str->lst ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] pos 1 ([color=BLUE]strlen[/color] del))) del)))
      ([color=BLUE]list[/color] str)
    )
  )

  ([color=BLUE]defun[/color] _putNth ( a n l )
    ([color=BLUE]if[/color] ([color=BLUE]and[/color] l ([color=BLUE]<[/color] 0 n))
      ([color=BLUE]cons[/color] ([color=BLUE]car[/color] l) (_putNth a ([color=BLUE]1-[/color] n) ([color=BLUE]cdr[/color] l)))
      ([color=BLUE]cons[/color] a l)
    )
  )

  ([color=BLUE]setq[/color] PreferenceFiles ([color=BLUE]vla-get-files[/color] ([color=BLUE]vla-get-preferences[/color] ([color=BLUE]vlax-get-acad-object[/color])))
        SupportPaths    (_str->lst ([color=BLUE]vla-get-SupportPath[/color] PreferenceFiles) [color=MAROON]";"[/color])
  )
  ([color=BLUE]vla-put-SupportPath[/color] PreferenceFiles
    (_lst->str
      ([color=BLUE]apply[/color] '[color=BLUE]append[/color]
        (_putNth
          ([color=BLUE]setq[/color] lst
            ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( s ) ([color=BLUE]member[/color] s SupportPaths)) lst)
          )
          n ([color=BLUE]mapcar[/color] '[color=BLUE]list[/color] SupportPaths)
        )
      )
      [color=MAROON]";"[/color]
    )
  )
  lst
)

Example Function call:

Code: [Select]

(LM:AddSupportPathsAtN '("C:\\Folder" "C:\\Folder\\SubFolder") 4)
Position is zero-based, consistent with LISP list functions, if position argument is nil folders are added to the top of the tree.

Lee

[Serge J. Gianolla]

Wow, you ever sleep? 

Thanx, will take this for a spin.

[Serge J. Gianolla]

Yep, she works.

Thanks again Lee. 

[kdub_nz]

or
http://www.theswamp.org/index.php?topic=33548.msg389252#msg389252

[Serge J. Gianolla]

or
http://www.theswamp.org/index.php?topic=33548.msg389252#msg389252

Thanks to the artist formerly known as Kerry

Correct me if wrong, but can you define a placement in the tree for above link? What's the weather like in Brisbane?

[Lee Mac]

You're welcome Serge 

[kdub_nz]

or
http://www.theswamp.org/index.php?topic=33548.msg389252#msg389252

Thanks to the artist formerly known as Kerry

Correct me if wrong, but can you define a placement in the tree for above link? What's the weather like in Brisbane?

Hi Serge,
It's a little wetter than where you are ..
but wet one day, perfect the next

There would be a little more work required to "Insert" the entry.
Shouldn't be too difficult ;

Test if the item is in the list,
   if so, remove it.

find the index for the insert, pop the item into the list after the index

Re-write the SupportPaths to the Preference files ..

I'm brain dead at the moment, but I'll have a play in a couple of days if no-one else steps up.

Be Well,

[highflyingbird]

here is an example:

Code: [Select]

;;; --------------------------------------------------------------------
;;; Function: Add a path and its subdirectories to AutoCAD support path.
;;; Highflybird  2011.4.25                                             
;;; --------------------------------------------------------------------

(vl-load-com)
(prompt "The command is: Test")

(defun c:test(/ *Shell FSO Folder Path LastString LST OldSupportPath NewSupportPath)
  ;; Search All the Subdirectories
  (defun SearchPath (path / f n p Dirs)
    (setq Dirs (vl-directory-files path nil -1))
    (setq f (car Dirs))
    (and (= f ".") (setq Dirs (cddr Dirs)))
    (foreach n Dirs
      (setq p (strcat Path n "\\"))
      (setq Lst (cons p Lst))
      (SearchPath p)
    )
    lst
  )
 
  (setq *Shell (vlax-create-object "Shell.Application")) ;Create a Shell Object to select folder
  (setq FSO (vlax-create-object "Scripting.FileSystemObject")) ;Create a File system object to check the Folder.
  (setq Folder
    (vlax-invoke *Shell 'BrowseForFolder ;Browse for folder
      (vla-get-hwnd (vlax-get-acad-object))
      "Select a Folder"
      83
    )
  )

  (if (and Folder
   (setq Path (vlax-get (vlax-get Folder 'self) 'path))
   (/= (vlax-invoke FSO 'FolderExists Path) 0)
      )
    (progn
      (setq LastString (substr path (strlen path)))
      (if (or (/= LastString "\\") (/= LastString "/") )
(setq Path (strcat Path "\\"))
      )
      (setq Lst (list Path))
      (setq Lst (reverse (SearchPath Path)))
      (setq OldSupportPath (getenv "ACAD")) ;Get old support path
      ;;(setvar "USERS1" OldSupportPath)
      (setq NewSupportPath OldSupportPath)
      (foreach p Lst
(setq NewSupportPath (strcat NewSupportPath ";" p))
      )
      (setenv "ACAD" NewSupportPath) ;set new support path
    )
  )
  (and FSO (vlax-release-object FSO))
  (and *SHELL (vlax-release-object *SHELL))
  (princ)
)