[编程交流] LISP安装支持路径a

;inform the user how to run the application
(prompt "\nMy_Menu Menu Installer Loaded...Type My_Menu to run......")
;define the function
(defun C:My_Menu ( / flag1 loaded temp)
 (setq _ACADVERSION (atof (getvar "ACADVER")))
 (if (>= ACADVER 19.0) ; AUTOCAD 2013 or 2014
   (setq _MENUNAME "My_Menu.cuix")
   (setq _MENUNAME "My_Menu.cui")
   ); end if
 
;add the new support paths
         (addSupportPath "//a_very_long/novell/path/VLISP" 5)
         (addSupportPath "//a_very_long/novell/path/VLISP/3rdPartyLisp" 6)          
;set the flag
(setq flag1 T)
;check if the menu is not already loaded
(setq loaded (menugroup "_MENUNAME"))
;if it is not loaded
(if (= loaded nil)
  ;do the following
  (progn
;find the menu file
       (setq temp (findfile _MENUNAME))
   ;if you find the menu
          (if temp
        ;do the following
                  (progn
                ;switch off dialogues
                (setvar "FILEDIA" 0)
                ;load the menu
                    (command "menuload" _MENUNAME)
                ;switch on dialogues
                (setvar "FILEDIA" 1)
                ; This is for later use
                       ;install the pulldown
                    ;(menucmd "P11=+VBAMENU.POP1")
                ;inform the user
                              (prompt "\nLoading My_Menu....\n")
        );progn
        ;menu not find, so do the following
        (progn
                ;inform the user
                       (alert "Cannot Locate My_Menu Menu.
                 \nCall System Administrator.")
                ;clear the flag        
                (setq flag1 nil)
        );progn
   );if
   );progn
);if
        ;if the flag is set
        (if flag1
                ;inform the user
                              (prompt "\nVBA Menu Loaded....\n")
        );if
   (princ)
);defun
;subroutine to add support path
(defun addSupportPath (dir pos / tmp c lst)
(setq tmp ""
      c -1
)
(if
        (not
          (member (strcase dir)
                (setq lst 
                  (mapcar 'strcase 
                        (parse (getenv "ACAD") ";")
                  )
                );setq
          );member
        );not        
(progn
        (if (not pos)
                (setq tmp (strcat (getenv "ACAD") ";" dir))
                (mapcar '(lambda (x)
                (setq tmp (if (= (setq c (1+ c)) pos)
                                (strcat tmp ";" dir ";" x)
                                (strcat tmp ";" x)
                          )
                )
                )
        lst
        )
)
(setenv "ACAD" tmp)
)
)
(princ)
)
;parsing routine
(defun parse (str delim / lst pos)
(setq pos (vl-string-search delim str))
(while pos
        (setq lst (cons (substr str 1 pos) lst)
                str (substr str (+ pos 2))
                pos (vl-string-search delim str)
        )
)
(if (> (strlen str) 0)
        (setq lst (cons str lst))
)
        (reverse lst)
)
(princ);clean load

(command "._MENULOAD" "I:/My_Path/My_Menu.cuix")

; just 1 part of all the Config files stuff
;make new support paths exist + new
; By BIGAL 2014
(setq *files*  (vla-get-files  (vla-get-preferences (vlax-get-Acad-object))))
(setq paths (vla-get-SupportPath *files*))
;make new support paths exist + new
(setq cpaths 
 "P:\\autodesk\\supportfiles;
 P:\\autodesk\\lisp;
 P:\\autodesk\\fonts;
 P:\\autodesk\\hfs fonts;"
 )
(setq newpath (strcat cpaths paths))
(vla-put-SupportPath *files* newpath)
; end use of *files*
(vlax-release-object *files*)

(defun C:smc-melb ( / flag1 loaded temp)
;set the flag
(setq flag1 T)
;check if the menu is not already loaded
(setq loaded (menugroup "SMC-Melbourne"))
;if it is not loaded
(if (= loaded nil)
  ;do the following
  (progn
;find the menu file
       (setq temp (findfile "SMC-Melbourne.MNU"))
   ;if you find the menu
          (if temp
 ;do the following
    (progn
  ;switch off dialogues
  (setvar "FILEDIA" 0)
  ;load the menu
      (command "menuload" "SMC-Melbourne")
  ;switch on dialogues
  (setvar "FILEDIA" 1)
  ;install the pulldown
      (menucmd "P15=+SMC-Melbourne.POP25")
  ;inform the user
         (prompt "\nLoading SMC Melbourne Menu....\n")
 );progn
 ;menu not find, so do the following
 (progn
  ;inform the user
                       (alert "SMC Melbourne Not Installed.....")
  ;clear the flag 
  (setq flag1 nil)
 );progn
   );if
   );progn
);if
 ;if the flag is set
 (if flag1
  ;inform the user
         (prompt "\nSMC Melbourne Loaded....\n")
 );if
   (princ)
);defun