使用 VBA 添加支持路径

(defun addSP (dir pos / tmp c lst)
  (setq        tmp ""
        c   -1
  )
  (if
    (not
      (member (strcase dir)
              (setq lst (mapcar 'strcase (parse (getenv "ACAD") ";")))
      )
    )
     (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)
)
;
;
;
;
;
(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)
)
  Arguments : A folder path and the position at which to insert it. (0 based.)
  Here's an example to add a support folder :
(addSP "c:\\afralisp" 3)
I , personally , added in the lisp file the following in order to call it directly an set my support paths :
( defun c:LoadMySupportPaths ( )
  ( addSP "c:\\Windows" 0)
  ( addSP "d:\\Windows" 1)
)

Public Sub ACADStartup()
    Dim supppath As String
    'This will prevent you entering the same entry more than once
    supppath = UCase(ThisDrawing.Application.Preferences.Files.SupportPath)
    If Not (InStr(1, supppath, "U:\TITLEBLOCKS") > 1) Then
        ThisDrawing.Application.Preferences.Files.SupportPath = supppath & ";U:\TITLEBLOCKS"
    End If
    supppath = UCase(ThisDrawing.Application.Preferences.Files.SupportPath)
    If Not (InStr(1, supppath, "U:\SYMBOLS") > 1) Then
        ThisDrawing.Application.Preferences.Files.SupportPath = supppath & ";U:\SYMBOLS"
    End If
    supppath = UCase(ThisDrawing.Application.Preferences.Files.SupportPath)
    If Not (InStr(1, supppath, "U:\PROJECTLOGS") > 1) Then
        ThisDrawing.Application.Preferences.Files.SupportPath = supppath & ";U:\PROJECTLOGS"
    End If
    Exit Sub
End Sub