自动将加载的Lisp所在路径加入Support

st788796 · 发表于 2013-7-10 09:20:01

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有帐号？立即注册

x

[ 本帖最后由 st788796 于 2013-7-10 18:20 编辑 ]\n\n[ 本帖最后由 st788796 于 2013-7-10 18:20 编辑 ]\n\n[ 本帖最后由 st788796 于 2013-7-10 12:07 编辑 ]\n\n

(defun XD::String:Parse (str delimiter / post strlst strl)
(if str
(progn
(setq strlst '()
strl (strlen delimiter)
)
(while (vl-string-search delimiter str)
(setq post (vl-string-search delimiter str))
(setq strlst (append strlst (list (substr str 1 post))))
(setq str (substr str (+ post (1+ strl))))
)
(vl-remove "" (append strlst (list str)))
)
)
)
(defun XD::AutoLoadLisp (/ htm Clip_Bord txt path)
(setvar "cmdecho" 0)
(vl-cmdf ".copyhist")
(setq htm (vlax-create-object "htmlfile")
Clip_Bord (Vlax-Get-Property
(Vlax-Get htm 'ParentWindow)
'ClipboardData
)
)
(setq txt (reverse
(mapcar 'strcase
(reverse (xd::string:parse
(Vlax-Invoke Clip_Bord 'GetData "text")
"\r\n"
)
)
)
)
txt (mapcar '(lambda (x)
(if (wcmatch x "命令:*")
(substr x 7)
(subst x 10)
)
)
tx
)
txt (vl-remove-if-not '(lambda (x) (wcmatch x "*LOAD*")) txt)
)
;;晓东通用LISP函数库Build 2013.07.03加载完毕...!
(if txt
(progn
(if (wcmatch (car txt) "*APPLOAD")
(setq patch (vl-registry-read
(strcat "HKEY_CURRENT_USER\\"
(vlax-product-key)
"\\Profiles\\"
(Getvar "Cprofile")
"\\Dialogs\\Appload"
)
"Maindialog"
)
) ;_appload 加载的
(setq path (vl-filename-directory
(substr (vl-string-trim "(,)" (car txt)) 7)
)
) ;_窗口拖入或者手动加载的
)
(if
(and path
(not
(vl-position
(strcase path)
(mapcar 'strcase (xd::string:parse (getenv "ACAD") ";"))
)
)
)
(setenv "ACAD"
(strcat (getenv "ACAD") ";" path)
)
)
)
)
(vlax-release-object htm)
(princ)
)
(defun c:Autoloadlisp () (XD::AutoLoadLisp) (princ "\nStart Command with Autoloadlisp to ADD Support Path!") (princ))
(princ)

(defun XD::String:Parse (str delimiter / post strlst strl) 
  (if str 
    (progn 
      (setq strlst '() 
     strl   (strlen delimiter) 
      ) 
      (while (vl-string-search delimiter str) 
 (setq post (vl-string-search delimiter str)) 
 (setq strlst (append strlst (list (substr str 1 post)))) 
 (setq str (substr str (+ post (1+ strl)))) 
      ) 
      (vl-remove "" (append strlst (list str))) 
    ) 
  ) 
) 
(defun XD::AutoLoadLisp (/ htm Clip_Bord txt path) 
  (setvar "cmdecho" 0) 
  (vl-cmdf ".copyhist") 
  (setq htm   (vlax-create-object "htmlfile") 
 Clip_Bord (Vlax-Get-Property 
      (Vlax-Get htm 'ParentWindow) 
      'ClipboardData 
    ) 
  ) 
  (setq txt (reverse 
       (mapcar 'strcase 
        (reverse (xd::string:parse 
     (Vlax-Invoke Clip_Bord 'GetData "text") 
     "\r\n" 
          ) 
        ) 
       ) 
     ) 
  txt (mapcar '(lambda (x) 
         (if (wcmatch x "命令:*") 
    (substr x 7) 
    (subst x 10) 
         ) 
       ) 
      tx 
     ) 
 txt (vl-remove-if-not '(lambda (x) (wcmatch x "*LOAD*")) txt) 
  ) 
  ;;晓东通用LISP函数库Build 2013.07.03加载完毕...! 
  (if txt 
    (progn 
      (if (wcmatch (car txt) "*APPLOAD") 
 (setq patch (vl-registry-read 
        (strcat "HKEY_CURRENT_USER\\" 
         (vlax-product-key) 
         "\\Profiles\\" 
         (Getvar "Cprofile") 
         "\\Dialogs\\Appload" 
        ) 
        "Maindialog" 
      ) 
 ) ;_appload 加载的 
 (setq path (vl-filename-directory 
       (substr (vl-string-trim "(,)" (car txt)) 7) 
     ) 
 ) ;_窗口拖入或者手动加载的 
      ) 
      (if 
 (and path 
      (not 
        (vl-position 
   (strcase path) 
   (mapcar 'strcase (xd::string:parse (getenv "ACAD") ";")) 
        ) 
      ) 
 ) 
  (setenv "ACAD" 
   (strcat (getenv "ACAD") ";" path) 
  ) 
      ) 
    ) 
  ) 
  (vlax-release-object htm) 
  (princ) 
) 
(defun c:Autoloadlisp ()   (XD::AutoLoadLisp)   (princ "\nStart Command with Autoloadlisp to ADD Support Path!")   (princ)) 
(princ)

牢固 · 发表于 2013-7-10 11:29:34

有一个笔误： "Maildialog"==>"Maindialog"

牢固 · 发表于 2013-7-10 12:02:12

本帖最后由牢固于 2013-7-10 12:21 编辑

这句代码是有问题的：
(setq txt (mapcar '(lambda (x) (vl-string-trim "COMMAND: " x)) txt))
它会把 "APPLOAD" 或"COMMAND: APPLOAD"变成 “PPL”, 就不会得到正确结果啦！用vl-string-subst函数替换吧！

牢固 · 发表于 2013-7-10 12:44:04

发现该函数在拖入加载方式时无效，将本函数放入叫加载的程序里，拖入窗口加载改程序，得不到加载的路径！因为函数运行时，程序的加载在命令行里还没有开始回显加载路径，所以也就得不到路径！
通过appload加载方式是可以得到路径的！

zhangq_cai1 · 发表于 2013-7-10 13:54:11

学习了·~~~~~~~~~~~~~~~~~~~~~~~~~~~

st788796 · 发表于 2013-7-10 17:08:24

牢固发表于 2013-7-10 12:44
发现该函数在拖入加载方式时无效，将本函数放入叫加载的程序里，拖入窗口加载改程序，得不到加载的路径！因 ...

测试了下用 vl-string-trim 还是有Bug，trim 的是匹配符，不是字符串，所以这个还是应该用 Substr
另外这个拖入G版说的对，拖入的时候是内存加载，回先不到命令行，正确的应该有个命令，拖入后运行就可以了。
_$ (vl-string-trim "COMMAND: " "COMMAND: AP APPLOAD")
"P APPL"

st788796 · 发表于 2013-7-10 18:22:01

本帖最后由 st788796 于 2013-7-10 18:25 编辑

牢固发表于 2013-7-10 12:02
这句代码是有问题的：
(setq txt (mapcar '(lambda (x) (vl-string-trim "COMMAND: " x)) txt))
它会把 " ...

用 Substr 替换了，最后增加个提示，用命令添加
放入 xd-lisp-lib.vlx 并和 xdrxapi 在同一路径下，就可以实现自动添加路径并加载 api
下一个可以用 vl-registry-write 将 xdrxapi 写入自动加载

sicky111 · 发表于 2013-7-10 21:44:15

这个函数牛，想不到还真的能实现自动加载路径。

GTJ116600 · 发表于 2013-7-10 21:55:59

好函数，留个记号

gdslqs · 发表于 2013-7-11 10:33:41

有没有对应的函数：把已经添加进支持路径删除，包括删除注册表里面的东西

st788796 · 发表于 2013-7-11 13:37:56

gdslqs 发表于 2013-7-11 10:33
有没有对应的函数：把已经添加进支持路径删除，包括删除注册表里面的东西

删除路径好办，注册表删除用 vl-registry-delete ，这个函数不能对 HKLM 操作

牢固 · 发表于 2013-7-11 14:09:27

st788796 发表于 2013-7-11 13:37
删除路径好办，注册表删除用 vl-registry-delete ，这个函数不能对 HKLM 操作

支持路径存放在注册表 HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R16.0\ACAD-201:804\Profiles\<<未命名配置>>\General\ACAD 位置，直接通过修改注册表 ACAD 键值好像不能达到修改支持路径效果！修改键值后，关闭CAD，再打开CAD，注册表键值又被恢复了！
我怀疑是不是CAD打开后，这些环境变量是驻留在内存里，退出CAD后再恢复到注册表去！所以只能在CAD里修改！

newer · 发表于 2013-7-11 14:22:34

牢固发表于 2013-7-11 14:09
支持路径存放在注册表 HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R16.0\ACAD-201:804\Profiles\\Gen ...

哦？那G版，你修改注册表后，别进CAD，重新启动下机器看看，进CAD还给修改回去不？如果还是修改回去，那就说明还有其他地方存这个路径了，还需继续找。

st788796 · 发表于 2013-7-11 14:41:42

牢固发表于 2013-7-11 14:09
支持路径存放在注册表 HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R16.0\ACAD-201:804\Profiles\\Gen ...

支持路径直接用 (setenv "ACAD" path) 修改不能保存？

牢固 · 发表于 2013-7-11 15:18:21

st788796 发表于 2013-7-11 14:41
支持路径直接用 (setenv "ACAD" path) 修改不能保存？

(SetEnv “ACAD" path) 当然可以修改支持路径那个！

帐号		自动登录	找回密码
密码			立即注册

[选择集] 自动将加载的Lisp所在路径加入Support

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

点评

点评

点评

点评

点评

点评