Toolbar Macros From Lisp

[CADWarrior]

Ok this is working just like I want it to the only issue is that now when I go the tool bar and try to run the macros assigned to Menu item.

 

Expected Outcome for Macro

Command: (FD "C:\\Users\\Matrix\\Desktop\\Autocad Test")
Command: (ib "C:\\Users\\Matrix\\Desktop\\Autocad Test\\Blah.dwg")

 

Actual Outcome for Macro to some effect

Command: (FD "C:

Command: (ib "C:

 

This was made for my flashdrive system but here is the code if you wish to try it. You need to specify where to save the .msn file and the folder to crawl through.

 

Purpose of lisp: Find all subdirectories in directory. Find all drawings in those subdirectories. Populate a toolbar with Name of drawings and all subdirectories.

 

(vl-load-com)

(defun FD (loc / )
 (startapp "explorer.exe" loc)
 )

(defun ib (loc / )
 (command "-insert" "" loc)
 )

(setq dirltr (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))
(foreach Dir dirltr
 (if (or (/= (findfile (strcat Dir":\\MP.lsp")) nil) (/= (findfile (strcat Dir":\\MP.fas")) nil))
   (setq Path Dir)
   )
 )
(setq flag nil)
(if (not (findfile (strcat Path":\\Test.mns")))
 (progn
   (setq fn (open (strcat Path":\\Test.mns") "w"))
   (close fn)
   )
 )
(setq acadobj (vlax-get-acad-object))
(setq thisdoc (vla-get-activeDocument acadobj))
(setq menus (vla-get-menuGroups acadobj))
(vlax-for n menus
 (if (= (vla-get-name n) "Test")
   (setq flag T)
   )
 )
(if (not (menugroup "Test"))
 (vla-load menus (strcat Path":\\Test.mns"))
 )
(setq currMG (vla-item menus "Test"))
(if (<= (vla-get-count (vla-get-menus currMG)) 0)
 (progn
 (setq path "C:\\Users\\Matrix\\Desktop\\Autocad Test")
 (setq mainfolders (vl-directory-files path nil -1))
 (setq mainfolders (vl-remove "." mainfolders))
 (setq mainfolders (vl-remove ".." mainfolders))
 (setq newfolders mainfolders)
 (setq mainfiles nil)
 (setq tempfiles (vl-directory-files path "*.dwg" 1))
 (foreach file tempfiles
   (setq mainfiles (append mainfiles (list (list "" file))))
   )
 (while newfolders
   (foreach folder newfolders
     (setq newfolders (vl-remove folder newfolders))
     (setq temppath (strcat path "\\" folder "\\"))
     (setq tempfolders (vl-directory-files temppath nil -1))
     (setq tempfolders (vl-remove "." tempfolders))
     (setq tempfolders (vl-remove ".." tempfolders))
     (foreach temp tempfolders
(setq mainfolders (append mainfolders (list (strcat folder "\\" temp))))
(setq newfolders (append newfolders (list (strcat folder "\\" temp))))
)
     )
   )
 (foreach dir mainfolders
   (setq tempfiles (vl-directory-files (strcat path "\\" dir "\\") "*.dwg" 1))
   (foreach file tempfiles
     (setq files (append files (list (list dir file))))
     )
   )
 (setq subfolders nil)
 (foreach file files
   (setq subfolders (append subfolders (list (nth 0 file))))
   )
 (setq subfolders (vl-sort (foreach item subfolders (setq subfolders (cons item (vl-remove item subfolders)))) '<))
 (setq subfolders (vl-remove "" subfolders))
 (setq subfoldtomake nil)
 (foreach subfolder subfolders
   (setq folderext subfolder)
   (if (vl-string-search "\\" subfolder)
     (progn
(setq subfoldarray nil)
(while (setq subpos (vl-string-search "\\" subfolder))
  (setq subfold (substr subfolder 1 subpos))
  (setq subfolder (substr subfolder (+ 1 (strlen (strcat subfold "\\"))) (strlen subfolder)))
  (setq subfoldarray (append subfoldarray (list subfold)))
  )
(setq subfoldarray (append subfoldarray (list subfolder)))
(setq subfoldtomake (append subfoldtomake (list subfoldarray)))
)
     (progn
(setq subfoldtomake (append subfoldtomake (list (list subfolder))))
)
     )
   )
 (setq newMenu (vla-add (vla-get-menus currMG) "&Test"))
 (setq menulist nil)
 (setq menulist (append menulist (list (list "" newmenu))))
 (foreach subfolder subfoldtomake
   (setq menuext "")
   (setq lastmenu newMenu)
   (foreach folder subfolder
     (progn
(setq flag nil)
(if (= menuext "")
  (setq menuext (strcat folder))
  (setq menuext (strcat menuext "\\" folder))
  )
(foreach menu menulist
  (if (wcmatch (nth 0 menu) menuext)
    (progn
      (setq flag t)
      (setq lastmenu (nth 1 menu))
      )
    )
  )
(if (= flag nil)
  (progn
    (setq lastmenu (vla-addsubmenu lastmenu (1+ (vla-get-count lastmenu)) folder))
    (setq menulist (append menulist (list (list menuext lastmenu))))
    )
  )
)
     )
   )
 (foreach menufd menulist
   (vla-AddSeparator (nth 1 menufd) (1+ (vla-get-count (nth 1 menufd))))
   (setq tbcommand (strcat (chr 3) (chr 3) "(FD \"" path "\\" (nth 0 menufd) "\")" (chr 32)))
   (alert tbcommand)
   (setq newMenuItem (vla-addMenuItem (nth 1 menufd) (1+ (vla-get-count (nth 1 menufd))) "Find Dir" tbcommand))
   (vla-put-helpString newMenuItem "Find This Menu's Dir")
   (vla-AddSeparator (nth 1 menufd) (1+ (vla-get-count (nth 1 menufd))))
   )
 (foreach file files
   (foreach menu menulist
     (if (wcmatch (nth 0 file) (nth 0 menu))
(setq menulocation (nth 1 menu))
)
     )
   (progn
     (setq tbcommand (strcat (chr 3) (chr 3) "(ib \"" path "\\" (nth 0 file) "\\" (nth 1 file) "\")" (chr 32)))
     (alert tbcommand)
     (setq newMenuItem (vla-addMenuItem menulocation (1+ (vla-get-count menulocation))(vl-filename-base (nth 1 file)) tbcommand))
     (vla-put-helpString newMenuItem "Insert Block")
     )
   )
 (vla-insertInMenuBar newMenu (vla-get-count (vla-get-menuBar acadobj)))
 )
 )
(princ)

 

 

Any help on this would be greatly appreciated.

 

Thank you,

 

CadWarrior

Edited June 3, 2013 by CADWarrior
2, to, too, and two. I just so happen to pick Too instead of To. Too many two (2) types to handle.

[Lee Mac]

Use forward slashes as filepath delimiters, the backslash is a macro operator to pause for user input.

[CADWarrior]

Thank you Lee Mac. It never crossed my mind that "\" was a built in macro command.

[Lee Mac]

You're welcome; here is a reference:

 

http://exchange.autodesk.com/autocad/enu/online-help/browse#WS73099cc142f4875513fb5cd10c4aa30d6b-7d07.htm

[CADWarrior]

Maybe you could help me with one more thing Lee. Not sure what is causing this issue. But if a DWG in the main folder has the same name as any other DWG as the subdirectories it errors out. I have checked, double checked and triple check that the vla-addMenuItem is pointing to the correct Menu and submenus. The only thing I can think of is that

(setq newMenu (vla-add (vla-get-menus currMG) "&Test"))

only allows unique names in the entire menu structure. Where vla-addsubmenu then allows you to put what ever name you want as long as it doesn't have the same name in said menu directory.

 

Test 1. Removed Duplicated name from main folder (worked)

Test 2. Made Duplicate in Main folder. Removed All Duplicated names from subfolders (worked)

Test 3. Stored information in an array to make sure that all files where pointing to the correct menus(worked as intended)

 

 

Edit:

 

Ok I cheated. Figured, well if Subdirectory allows me to add what ever I would like, even if it is a duplicate, I will add the main menu options first and then add any subdirectory items....... Go figure it works. Is there any to get around this? I am still assuming this isn't working as intended.

Edited June 3, 2013 by CADWarrior