[求助]如何用LISP加载PGP文件

cadm0211

本人在做一个安装包，想把自定义的PGP文件，在安装的时候自动加载或替换原始PGP文件，请问怎么写？
还请大家帮忙。

lionyoyo

;;; 使用自定义PGP文件
;;; 2008.04.12完成
(vl-load-com)
(defun cionel_PGP ( / fil Lionel:PGP ShortFun FullFun interCmdList StrDef )
  (setq fil (open (findfile "Lionel_PGP.pgp") "r");路径待修改
        Lionel:PGP (ReadPGP fil)
        ShortFun T
        FullFun T
        StrDef ""
        n 0
        interCmdList (atoms-family 1)
  );setq
  (while (< n (length Lionel:PGP))
    (setq ShortFun (car  (nth n Lionel:PGP))
          FullFun  (cadr (nth n Lionel:PGP))
    );setq
    (if (member FullFun interCmdList)
      (setq StrDef (strcat "(defun c:" ShortFun "() (princ \" " (strcase FullFun) " \") (command \"" FullFun "\") (princ) )")); 内部命令
      (setq StrDef (strcat "(defun c:" ShortFun "() (princ \" " (strcase FullFun) " \") (c:" FullFun ") (princ) )")); 外部命令
    );if
    (eval (read StrDef))
;;(princ StrDef)
    (setq n (1+ n))
  );while
  (princ "\n自定义PGP文件加载完成!")
  (princ)
);defun

(defun ReadPGP (fil / strline return i n separator ShortFun FullFun)
  ;(open fil r)
  ;(open fil_temp w)
  (setq strline (read-line fil)
        return ()
        i 1 ; 行计数器
  )
  (while (/= strline nil)
;;(princ (vl-string->list strline))
    (setq strline (substr strline 1 (vl-string-search ";" strline)) )
    (mapcar '(lambda (ch)
               (setq oldstr "")
               (while (/= oldstr strline)
                 (setq oldstr strline
                       strline (vl-string-subst "" ch strline) 
                 )
               );while
              )
              '(" " "\t" "　")
    ); mapcar
;; 清理半角空格,全角空格,制表符
    (setq separator (vl-string-search ",*" strline))
    (if (= "" strline) nil
     (if (null separator)
      (progn
        (Alert (strcat "PGP文件第" (itoa i) "行格式错误，请核实！"))
        (princ (strcat "\nPGP文件第" (itoa i) "行格式错误，请核实！"))
      );progn
      (progn
        (setq ShortFun (substr strline 1 separator)
              FullFun  (substr strline (+ separator 3))
              return (cons (list ShortFun FullFun) return)
        );setq
      );progn
     );if
    );if
    (setq strline (read-line fil)
          i (1+ i))   
  );while
  (reverse return)
);defun

(princ);; 静默退出加载

cadm0211

你这个可以自动加载吗？要打命令的吧

lionyoyo

用(cionel_PGP)调用

hyccai

研究下

yxp

;;刚好我也弄了一个简单点的。

(defun c:repgp( / f_txt n cctd)
(setq f_txt (open (findfile "acad.pgp") "r"))  ;;打开原来的pgp文件，准备修改
(setq cctd '())                                ;;存放读取pgp文件的文本行
    (while (setq txt_row (read-line f_txt))
           (if (= txt_row "C,         *CIRCLE")(setq txt_row "C, *COPY"))  ;;好了，开始替换吧，把C替换为copy
           (if (= txt_row "D,         *DIMSTYLE")(setq txt_row "D, *PAN")) ;;把d替换为pan
           (if (= txt_row "V,         *VIEW")(setq txt_row "V, *matchprop"))
           (setq cctd (cons txt_row cctd))
    ) (close f_txt)
  (setq cctd (reverse cctd) n 0)
  (setq f_txt (open (findfile "acad.pgp") "w"))
  (repeat (length cctd) 
          (write-line (nth n cctd) f_txt)
          (setq n (+ 1 n))
    )  (close f_txt)
  (command "reinit")
)

lionyoyo

6楼的办法很有意思，好像应该再加上一步备份acad.pgp就完美了

我的思路是打算进一步增强第三方PGP文件的功能
实现这样的格式：
pe,  *pline\pause\e\i\pause\/
等价于
(defun c:pe () (command "pline" pause "e" "i" pause "")
这样的功能
呵呵

FANGZHENG158

我用用看，我也想用这个

dxj958

能用，写得好

LLXXZZ

lionyoyo 发表于 2008-6-24 09:32
6楼的办法很有意思，好像应该再加上一步备份acad.pgp就完美了我的思路是打算进一步增强第三方PGP文件的功能 ...

想法不错,
不过可以试试脚本,感觉脚本实现要简单些.