[分享]：cad里安装程序其实就一拽那么简单

aeo

[php]
;;;-------------------------------------------------------------
;;;存成文件如abcd.lsp ，放入你程序所在的文件夹
;;;需要安装程序时，进入cad,把abcd.lsp拽入cad就算安装完了
;;;By Aeo @xdsoft.net
;;;-------------------------------------------------------------
(vl-load-com)
;;;====================
;;;生成菜单 ,如有自己的菜单，省略之
;;;--------------------
(defun $_to-write( / a )
    ;;写 mns (我的菜单去掉了大部分，可根据需要写)
    (setq a(open (strcat $load_path"\\" "temp-cht.mns" )"w"))
    (foreach x '("***MENUGROUP=temp-cht""""")(princ x a)(princ "\n" a))
    (foreach x(list
      "***SCREEN"
      "[文字外观]0"
      "[  UNDO  ]u"
      "[        ]"
      "[前一菜单](menucmd \"s=\")"
      
       )
      (princ x a)(princ "\n" a)(princ "[　　　　]" a)(princ "\n" a)
   )
  (repeat 20(princ "[　　　　]" a)(princ "\n" a))
  (close a)
  
    ;;写 mnl  (如果有自己菜单，要加入load ...)
  (setq a(open (strcat $load_path"\\" "temp-cht.mnl" )"w"))
      ;;(load \"QQQQ\")是你 所有程序的加载程序,关键！当然也可直接在mnl里写
  (princ "(load \"QQQQ\")"a)(princ "\n" a)
  (close a)
  
  (command "delay" 150)
)

;;;========================
;;;加载菜单
;;;------------------------
(defun reload-chtmenu()
    (if(menugroup "temp-cht")(progn
        (menucmd  "s=")
        (command "FILEDIA"0 "menuunload""temp-cht""FILEDIA"1)
    ))
    ($_to-write) ;;如有自己的菜单，省略这行,把temp-cht改成自己的
    (command "menuload" "temp-cht.mns")
)

;;;=======================
;;;加入路径  如果觉得不完美你可以改进!
;;;-----------------------
(defun $add_SupportPath (dir pos / lst n tmp)
  (setq n -1 lst '(0)
        tmp (getenv "ACAD")
  )
  (cond
       ((not pos)
           (setq tmp (strcat tmp ";" dir))
       )
       ((= pos 0)(setq tmp(strcat dir ";" tmp)))
       (t
         (while (setq n (vl-string-search ";" tmp (1+ n)))
                (setq lst(cons n lst))
          )
         (if(setq n(nth pos (reverse lst)))
            (setq tmp(strcat(substr tmp 1 n) ";" dir (substr tmp (1+ n)) ))
            (setq tmp (strcat tmp ";" dir))
         )
    )
  )
  (setenv "ACAD" tmp)
  (princ)
)

;;;=======================
;;;得到路径     02 07均试过，不知08怎么样.
;;;-----------------------
(defun $get_load_path( / !str n1 n2)
   (while(/= 0(getvar "cmdactive"))(command))
   (princ "\n")
   (setq !str(getvar "lastprompt"))
   (setq n1 (vl-string-search "(LOAD \"" !str)
         n2 (vl-string-search "\")" !str)
         !str(substr !str (+ n1 8) (- n2 n1 7))
         !str (vl-filename-directory  !str)
   )
)


;;;================================
;;;main   你可以利用 $load_path 作一点设置
;;;--------------------------------
(setq $load_path($get_load_path))
($add_SupportPath $load_path 1)
(reload-chtmenu)
(setq $load_path nil)
(princ)
[/php]

如果没什么改变，只要把上面的QQQQ改成你自己的程序名字就可

aeo

QQQQ.lsp示例

2. 
   
3. ;;预设
   
4. (setq a ...
   
5.          b....
   
6. )
   
7. ;;加载
   
8. (load "xdlisp")
   
9. 
   
10. (autoload aaa '(.......))
    
11. (autoload bbb '(.......))
    
12. ....
    

<br /> ;;预设<br /> (setq a ...<br />          b....<br /> )<br /> ;;加载<br /> (load "xdlisp")<br /> <br /> (autoload aaa '(.......))<br /> (autoload bbb '(.......))<br /> ....<br />

123456abc

没有看明白

浪奔

好好学习

xshrimp

得到加载路径存在bug ;)
当路径名太长时.显示的不是最后一个.提示.
命令:
命令: (LOAD "C:/Documents and Settings/Administrator/桌面/新建文件夹
(2)/2.lsp") nil

!str 此时值  为(2)/2.lsp")  了...
版主看看有什么好的解决方法...

hmillf

好像看不明白哦！ 这个程序可以实现永久性加载程序吗？  还有加载一个程序就生成一个菜单吗。

yinzhun22

试了下老是提示，程序输入列表有缺陷

swc00

kankan

swc00

看看

aeo

最初由 hmillf 发布
[B]好像看不明白哦！ 这个程序可以实现永久性加载程序吗？  还有加载一个程序就生成一个菜单吗。 [/B]

当然永久性的

aeo

最初由 xshrimp 发布
[B]得到加载路径存在bug ;)
当路径名太长时.显示的不是最后一个.提示.
命令:
命令: (LOAD "C:/Documents and Settings/Administrator/桌面/新建文件夹
(2)/2.lsp") nil

!str 此时值  为(2)/2.lsp")  了...
版?.. [/B]

是呀，换行了我也没办法