;;;Note: This routine is specifically written for AutoCAD 2004 registry keys. ;;;Adds 'pathlist' (a list of paths) to the "AutoCAD Support File Search Path" of all current user profiles ;;;Paths that already exist in the "AutoCAD Support File Search Path" are ignored. ;;;Paths that do not exist on the user workstation will not be added. ;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; http://paracadd.com ;;; All rights reserved. ;;; ;;; COPYRIGHT: 2-16-2008 ;;; EDITED: 2-16-2008 ;;; (DEFUN REGSETACAD (pathlist /) (IF (AND pathlist (EVAL (CONS 'AND (MAPCAR '(LAMBDA (x) (EQ (TYPE x) 'STR)) pathlist) ) ;_ end of CONS ) ;_ end of EVAL ) ;_ end of AND (FOREACH n (VL-REGISTRY-DESCENDENTS "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R16.0\\ACAD-208:409\\Profiles" ) ;_ end of vl-registry-descendents (IF (WCMATCH n "<<*") (SETQ this-acad-key NIL) (PROGN (SETQ this-acad-key (VL-REGISTRY-READ (STRCAT "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R16.0\\ACAD-208:409\\Profiles\\" n "\\General" ) ;_ end of STRCAT "ACAD" ) ;_ end of vl-registry-read ) ;_ end of SETQ (FOREACH n pathlist (IF (VL-DIRECTORY-FILES n nil -1) (SETQ listpaths (STRCAT (IF listpaths listpaths "" ) ;_ end of IF n ";" ) ;_ end of STRCAT ) ;_ end of SETQ (SETQ listnopaths (STRCAT (IF listnopaths listnopaths "" ) ;_ end of IF n ";" ) ;_ end of STRCAT ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of foreach ;;; (ALERT ;;; (STRCAT ;;; "Checking AutoCAD Support File Search Path for profile \"" ;;; n ;;; "\"\n" ;;; (IF listpaths ;;; (STRCAT listpaths " will be added if needed.") ;;; "" ;;; ) ;_ end of IF ;;; (IF listnopaths ;;; (STRCAT ;;; (IF listpaths ;;; "\n" ;;; "" ;;; ) ;_ end of IF ;;; "The following paths were specified but do not exist and will NOT be added:\n" ;;; listnopaths ;;; ) ;_ end of STRCAT ;;; "" ;;; ) ;_ end of IF ;;; ) ;_ end of STRCAT ;;; ) ;_ end of ALERT (IF this-acad-key (PROGN (SETQ acad-key this-acad-key) (FOREACH n pathlist (IF (AND listnopaths (WCMATCH listnopaths (STRCAT "*" n ";*")) ) ;_ end of AND NIL (IF (WCMATCH (STRCASE acad-key) (STRCASE (STRCAT "*" n ";*")) ) ;_ end of WCMATCH nil (SETQ acad-key (STRCAT acad-key n ";")) ) ;_ end of if ) ;_ end of IF ) ;_ end of FOREACH (SETQ listnopaths NIL listpaths NIL ) ;_ end of SETQ (IF (EQ this-acad-key acad-key) NIL (VL-REGISTRY-WRITE (STRCAT "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R16.0\\ACAD-208:409\\Profiles\\" n "\\General" ) ;_ end of STRCAT "ACAD" acad-key ) ;_ end of vl-registry-write ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of progn ) ;_ end of IF ) ;_ end of FOREACH (PRINC "\nERROR: One or more path specified in REGSETACAD function call were not strings. ") ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T) ;*** DO NOT add text below the comment! ***|;